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El.  source  listings 


Compound  Leg  Reverse  Solutions  and  Postprocessor 

CSEHP  -  CTEN3.  PAGES  /6S-22) 


ei  sys  f inal/t2for/csehp  forll 
subroutine  CSEHPl istart ) 

implicit  mteger#2  («) 
implicit  double  precision  (a-z) 

integer#?  istart 

integer  #2  ileg.tst  ,nca  >ncb  ,n»a  ,n»b  ,isol  , ibrnch  ,uz (5 ) 
double  precision  z  (67 1  ,cz  ,cx  ,d  ,ta  ,tb 

common  /VGL08/  i  leg  >tsf  ,nca  ,ncb  ,z  ,cz  ,cx  ,d  ,ta  ,tb  ,nwa  ,nwb  > 

&  i so I  > i brnch  ,uz 
double  precision  za(25 1  .zb (25 1 
equivalence  (z  (1  I  (zaM  I )  ,(z(26  1  ,zb(  I  I ) 

double  precision  ha  ,ala  ,va  ,s1a  ,wta  .cla  ,s2a  >«2a  ,c2a  ,s3a  ,«3a  , 

&  xa  ,va  ,xla  ix2a  ,x3a  ,yla  ,v2a  ,v3a  . 

&  t  ana2a  ,  t  ana3a  ,  t  ana4a ,  t  ana Sa  ,  t  ana6a  ,  I  a  .ph i a 
equivalence  (zall l  ,ha I  ,(za<2 1  ,ala  ,va)  , 

&  I  za  1 3  J  ,s  I  a )  ,  I  za  ( 4  )  ,» I  a  > ,  I  za  1 5 )  »c  1  a  >  , 

&  ( za  ( 6 1  >s2a  I  ,  ( za  ( 7  l  ,w2a  I  ,  I  za  ( 8 1  >c2a )  , 

&  (za  19  I  >s3a )  ,  ( za (10)  ,w3a I  ,  (za(  1  I  )  ,xa  )  ,  Iza  ( 1  2  )  >ya  l  , 

&  (za(  131  ,x  la)  ,<za(  HI  ,x2a)  .(za  (IS)  ,x3a)  , 

&  (za(16>  .via)  , ( za (17)  ,y 2a)  . ( za (18)  >y3a)  . 

&  l za (IQ)  ,tana2a)  ,  (za(201  .tana3al  ,(za(?1  I  ,tana4a)  , 

&  ( za ( 22 )  1 1  ana5a  I  .( za ( 23 1  » t ana6a 1  ,  l za ( 24  )  ,1a)  ,  ( za ( 25  >  ,ph i a ) 

double  precision  hb  ,alb  ,vb  .sib  ,wtb  .clb  ,s2b  ,w2b  ,c2b  ,s3b  ,*3b  , 

A  xb  >yb  .xlb  ,x2b  ,x3b  ,y1b  ,y2b  ,y3b  , 

A  t  ona2b  ,  t  ona3b  ,  t  ana4b  ,  t  ona5b  ,  t anaBb  ,  1 b  ,ph i b 
equivalence  (zb ( I  I  ,hb  )  . (zb (2 1  ,a(b  ,vb )  , 

&  ( zb ( 3  )  ,slb)  , ( zb ( 4  )  ,wlb )  , ( zb ( 5  )  .clb)  , 

&  ( zb (6 )  ,s2b)  >  ( zb ( 7  )  ,«2b)  ,(zb(8)  ,c2b)  , 

A  (zb (9 )  ,83b )  ,  (zb( 10 )  ,w3b I  ,  I  zb (II)  ,xb )  ,  Izbt 12 )  ,yb )  , 

&  ( zb ( 1 3 )  ,x  1  b  >  ,  ( zb ( 1 4  )  ,x2b )  ,( zb  (15)  ,x3b)  , 

&  (zb (16)  ,y1b)  , ( zb (17)  ,y2b)  ,(zb(  18)  ,y3b)  , 

3  t zb (19)  , tana2b)  , (zb  120)  ,tena3b>  , (zb (21  )  ,tenc4b)  , 

A  (zb (22  I  ,tano5b )  ,  (zb (23  )  ,tana6b )  ,  l zb (24 )  ,1b )  ,(zb(25 )  ,phib) 
double  precision  cot  1  >slp  ,frct  ,c3  ,s4  ,w4  ,x4  ,y4  ,tana7  ,tona8  >1  > 

&  h  ,phih  ,r  tot  ,xtot  ,ztot  ,do 

equivalence  (z(51 >  .cot  I  )  , ( z ( 52  )  ,slp)  ,  tz(53)  ,frct )  ,lzi54  )  ,c3)  , 
&  (Z  (55  )  ,s4  )  ,(z  (56  1  ,*4  I  ,(z  (57  )  ,x4  1  ,(z  (58  )  ,y4  )  , 

&  ( Z ( SO )  ,tana7)  ,(z(60)  ,tana8)  ,(z(61  1,1), 

&  ( z ( 62 1  ,h)  ,(z(63l  ,phih)  , 

&  (z(B4  )  ,rtot  I  ,(z(65)  ,xtot  )  .  ( z  ( 66  >  ,ztot  )  ,  1  z  ( 67  I  ,do  ) 


tnteger#2  nc(2) 
equ i va 1 ence  t  nca  ,nc ) 


double  precision  pi  ,hal fpi  .degrad  .raddeg  .zero  .one  ,hal f 

cowmonr/VCONST/  pu^a  I  fp?  .degrad  .raddeg  .zero  .one  .half. 
&  i zero  .  i one  >  1 1  »o 


double  precision  delyk  ,i *od  .hal fd >dsq 
common  /VANCH/  del yk  .» »od  .hal fd  ,dsq 

mteger*2  iscopa  , iscopb  .i  tana  >i  tanb  >1  >  .is 

common  /VCMPD/°epsy  .gamma  ,se  ,  i scopa  ,  i scopb  .  i ' ana  ,  1 »  onb  ,  M  ,  1 s 
integer *2  iscop(2l 
equivalence  ( iscopa >i scop ) 


inieaer*2  i  told 
double  precision 
common  /VEQUAL/ 


ss0  ,dten0  .ssl  .dtenl 
ss0.dten0.ss1  .dtenl  , 


,ss2  ,dt en2  ,slp0  >so0  .srnml 
ss2  ,dten2  ,slp0  .sa0  .srnin  , 


&  i  told 

equivalence  (smint  1  1  .samm 


,(smm (2)  .Sbminl 


2) 


double  precision  sa  >sb  ,ca  .cb  .vc0o (6  1  .vc0b  6  . 

&  eex0  .eez0  ,eey0  .a0  .b0  »ph  i  o0  .ph  i  b0 
integer *2  icase 

common  /VSPID/  sa  >sb  >co  .cb  >vc0a  .vc0b  . 

6  eex0  .eez0  ,eey0  ,o0  .b0  ,ph  i  o0  >ph  1 00  , 

&  tease 


inte 

********** 


i  s  t  r  t  - 1 8 1  or  t 

if  (z( i scopa  1  eq  so0-slp0i 


istrt-0 


z 1 iscopa )-8a0-8 lp0 

z ( i scopb l-ss-z < i scope ) 
call  CPREP1 
coll  CSSHP 
1 1-1  _ 
if  ltd  le  fb'  h-2 
i 8-3- i t 

call  FTEN(dten01 


if  (dten0  le  zero)  goto  2000 

i scop  t - 1 scop (it) 
i scops- 1 scop ( is  I 
ssmax-z ( i scops ) 
ssmm-sminl  is ) 

if  (ssmax  eq  ssmin)  goto  2000 

if  (it  ne  Hold  or  sst  eq  ssmin)  istrt-0 
if  (istrt  eq  0)  goto  )00 
ss0-ss2 
z ( i scops  )-ss0 
z ( iscopt  l-se-ss0 
call  CPREPI 
call  CSSHP 
call  ETEN(dten01 
ssl-0  9999d0*ss0+0  0001d0*ssmax 
goto  150 
100  corn inue 
ss0-ssmax 
ssl-ssmin 

if  (ssmin  gt  zero)  ss!  -ha  1  f  *  (ssmm+ssmox  1 
150  coni inue 

•rite  M0,*)  i  t  ,is  ,  i  scop  .se  , ssmin 

*n  te(  10  >*  )  ss0  .ia  itb  igamma  .dten0  ,isol  .ibrnch 

z ( i scops ) — ss 1 

z ( iscopt  )-se~ss1 

call  CPREPI 

call  CSSHP 

call  FTENldtenl ) 

wn  tel  10  »*  )  ssl.ta.tb  .gamma  .dtenl  ,isol  .ibrncn 
if  (istrt  ne  0)  goto  500  ____ 

if  (ss)  eq  ssmin  and  dtenl  gt  zero)  goto  2000 

300  con  1 1 nue 

if  (dtenl  le  zero)  goto  500 
ssl -hal f* (ssl ♦ssmin ) 

Z ( i scops  I -ssl 
z( iscopt l-se-ssl 
call  CPREPI 
call  CSSHP 

call  FTENldtenl)  , 

»nte(  )0.*>  ssl  ,ta  .tb  .gamma  .dtenl  >isol  .ibrncn 


500  cont inue 

c  t  o  t -ce+cb+c3+s1*w^ 
epsdf-ctoitl  0d-0 
i sec-3* i sir i 
ni  i-l 

1000  continue 

ss2-hel f* Iss0+ss1  I 

if  (isec  eq  0  and  dien0-dten1  gt  clot)  goto  1020 
isec-isec+1 

ss2-ss I -d  t  en I  * ( ss I -ss0 )  / ( d r en  t -d  f en0 ) 
ssm-ssmin 

if  (ssmm  gt  zero)  ssm-hal  f*  (ssmm+dminl  (ss0  ,ssi  1  ) 
ss2-dmin1 (ssmax  ,dmax 1 (ss2  ,ssm  1 ) 

1 020  cont  mue 

z ( ■ scops  1-ss2 
z  C  tscopt  1-se-ss2 
call  CPREP1 
call  CSSHP 
call  FTENldten2) 

write!  10.*)  ss2  ,ta  .tb  .gamma  ,dten2  itsol  .tbrnch 
if  (dabs(dten2)  It  epsdt  )  goto  2000 
if  ( n  1 1  eq  30 )  stop  111 
if  ( t sec  g t  3 )  goto  1 250 
if  (dten2  It  zero)  goto  1260 
S80-882 
dten0-dten2 
goto  1300 
1250  continue 
880-881 
dten0-dten1 
1260  continue 
SSl-882 
d  t  en 1 -d  t  en2 
1300  continue 
ni t-ni t+1 
goto  1000 

2000  con  1 1 nue 

slp-sa0-z( t  scope  1 
1 1  o 1 d- 1 1 


ei  sys  f inal/t2for/f ten  fori# 
subroutine  FTENIdeltenl 

************************************************************************ 

implicit  double  precision  (a-zl 

double  precision  del  ten 

integer*2  i  leg  ,ist  >nco  ,ncb  ,nwa  ,nwb  iisol  >ibrnch  ,uz  (5) 
double  precision  z  (67  1  ,cz  ,cx  ,d  ,  ta  ,tb 

common  /VCLOB/  i  leg  ,ist  ,nca  ,ncb  ,z  ,cz  ,cx  ,d  ,  ta  ,tb  ,n«a  ,n*B  , 

&  i sol  .ibrnch  ,uz 
double  precision  za(25  )  ,zb(25 I 
equivalence  ( z ( 1  1  ,za( 1  )  I  ,(z (26  1  ,zb ( 1  )  1 

double  precision  ha  >ala  .va  ,sla  ,«rla  .cla  ,s2a  ,*2a  ,c2a  ,s5a  ,*3a  . 

A  xa  ,ya  ,x  I  a  ,x2a  ,x3a  ,y  I  a  ,y2a  ,y3a  , 

A  t  ana2a  ,  t  ana3a  .  t  anaia  ,  t  anaSa  ■  t  ana6a  ,  I a  ,ph i a 
equ i va 1 ence  ( za ( I  I  iha 1  ,  ( za ( 2 )  ,a 1  a  , va 1  , 

A  ( za  ( 3  1  ,s  I  a )  ,  ( za  M  )  ,w  I  a  >  ,  ( za  (5 )  ,c  I  a  1  , 

A  ( za  ( 6  t  ,s2a  )  .  ( za  ( 7  I  ,w 2a  )  ,  ( zo  ( 8  )  ,c2o  I  » 

A  (za(9 )  ,s3a )  ,  (za( 10  )  ,w3a  )  ,  <za< 1 1  )  ,xa  1  ,  ( zai 1 2  I  ,va  I  > 

A  ( za  ( 1  3  )  ,x  I  a  l  i  ( za  ( 1 1 1  ,x2a  I  ,  I  za  ( 1 5  )  ,x3a  )  , 

A  ( za  ( 1 6  )  ,y  1  a  •  ,  ( za  1 1  7  J  ,y2a  l  ,  ( za  ( 1 8  )  ,y 3a  l  , 

A  (za(191  ,tana2al  ,  (za(20)  itana3a)  ,(za(2'  >  ,  tana^o)  > 

A  ( za ( 22  1  1 1 anaSa  )  ,  ( za ( 23  1  ,  t  ana6a  )  ,  ( za ( 24  )  .  I  a  I  > l zo ( 25 )  .ph i a ) 

double  precision  hb  ia1b  ivb  islb  ,»lb  >c  lb  ,s2b  ,*2b  »c2b  >s3b  ,w3b  , 

A  xb  ,yb  ,x  I  b  ,x2b  )x3b  >y  1  b  ,y2b  ,y  3b  , 

A  t  ana2b  ,  t  ano3b  ,  t  analb  ,  t  ana5b  1 1  ana6b , I b  >ph i b 

equ i va 1 ence  ( zb ( I  I  ,hb  I  > ( zb ( 2  I  ,a 1 b  ,  vb  1  . 

A  (zb<3)  .sib)  .(zb (I  I  ,w1b)  . ( zb ( 5  )  ,clbl  , 

A  ( zb  1 6  )  >s2b)  « I  zb  (71  ,w2b)  ,(zb(8)  ,c2b  I  , 

A  (zb (9 )  ,s3b I  > ( zb ( 1 0 )  ,«3b)  .  ( zb ( 1 l  )  ,xb  )  ,(zbil2>  ,yb  )  > 

A  (zb(  f  3 )  ,xlbl  ,(zb(MI  >x2b )  .  ( zb ( 1 5 1  ,x3b  )  > 

A  (zb  1161  ,ylb!  ,(zb(l7l  ,y2b)  ,lzbU8)  ,y3bl  > 

A  (zb (19)  >tona2b)  »<zb (20)  >tana3b)  .(zb(2l  I  , tana3bl  , 

A  (zb (22 1  ttanaSb  )  , (zb (23  I  1 1 ona6b )  , ( zb 124)  ,1b)  ,  (zb (25 )  ,phib ) 
double  precision  coi I  , sip  ,frct  ,c3  ,s4  ,xi  ,y<  , tana 7  , tana8  .1  , 

A  h  ,phih  ,r  tot  ,xtot  ,ztot  ,do 

equivalence  (z (51  I  ,coi 1  I  ,  (z (52  I  ,s lp  1  ,  (z (53  I  ,frct I  ,(z (5# 1 >c3 1  , 

A  lzC55)  ,s1)  ,(z(S6l  ,«M)  ,(z(S7l  ,x1l  ,lz(50l  ,y1)  , 

A  (Z(59)  ,tano7)  ,(z(60)  ,tono8)  >  (  Z  ( 6 1  )  >1  )  > 

A  ( z  1 62  )  ,h)  ,(z(63)  ,phih)  , 

A  (z(64)  ,rtot  1  ,(z(65)  ,xtot  I  ,  ( z  ( 66  )  >ztot  )  , ( z  1 6 7  >  ,do) 
double  precision  tjun(2) 


et  sys  f inal/t2for/csspr  fort! 
subroutine  CSSPR(ieps) 

implicit  integer $2  (*») 
implicit  double  precision  (a-z) 

integer %2  teps 

mt  eger*2  i  leg  >  i  s  t  ,nca  ,ncb  ,nwa  ,nwb  , i  sol  .  i bench  ,uz  15  ) 
double  precision  z  (67  I  ,cz  ,cx  ,d  ,ta  itb 

common  /VGLOB/  i  leg  list  ,nca  ,ncb  ,Z  icz  ,cx  ,d  >ta  ,tb  ,n«*a  ,n»b  , 

&  isol  ,ibrnch  ,uz 
double  precision  za(25  I  iZb(25  I 
equivalence  (z( 1  )  ,za( t  I  I  >(z(26)  ,Zb( I  )  ) 

double  precision  ha  ,ala  ,va  isla  .wla  >cla  (s2a  ,»2a  ,c2a  ,s3a  ,*3a  i 
4  xa  iya  ,x  1  a  ix2a  ix3a  ,y  1  a  iv2a  ,ySa  i 
4  t ana2a  ,tana3a  ,  tana4a  ,tana5a  ,tana6a  ,)a  ,phia 
equivalence  (za(l  1  ,ha  1  ,tza(21  >alo.v«l  • 

4  <za(3  1  ,sla  1  ,  <  za( 4  I  ,w  I  a  I  ,  ( za  1 5  I  ,c  la )  i 

4  ( za(6  I  ,s2a  I  ■  (  za  <  7  )  ,m2o  1  ,  ( za  (8  )  ,c2a  )  , 

4  ( za  (9  1  .s3a  1  ,  ( za  ( 10  I  ,w3a  I  ,  (za  (1  1  I  .xa  I  ,  l  za  l  I  2  I  ,va  I  , 

4  ( za  ( 1  3  )  .X 1  a  I  ,  ( za  (  M  I  ,x2a  l  ,  ( za  (1 5  )  ,x3a  )  , 

4  ( za  ( 1 6  1  ,y  1  a  )  i  ( za  ( I  7  I  ,y 2a  I  ,  ( za  ( 1 8  1  iy3o  )  , 

4  ( za ( 1 9  I  ,  t ana2a  I  ,  ( za ( 20  I  .  t  ana3a  1  ,  ( za ( 2 1  )  ,  t onala  )  , 

4  ( za ( 22  1  1 1  ana5a  I  ,  ( za ( 23  )  ,  i ana6a  1  t ( zo 1 24  )  ,1a)  ,  I za ( 25  )  ,ph i a  ) 

double  precision  hb  ,alb  ,vb  ,slb  ,»*1b  ,clb  ,s2b  ,w2b  ,c2b  ,s3b  ,w3b  i 
4  xb  iyb  ,xlb  ,x2b  ,x3b  (ylb  ,y2b  ,y3b  , 

4  t  ana2b  ,  t  ona3b  ,  t  ana4b  1 1  ana5b  ,  t  ana6b  ,  1 b  ,ph i b 
equ i valence  1  zb  1 1  1  ,hb  I  ,  ( zb (2  I  ,al b  (vb  1  i 
4  ( zb ( 3  )  iS I b  l  ,  ( zb (4  I  >w I  b  I  ,  ( zb ( 5  I  ,c  1  b  )  , 

4  lzb(61  ,s2b  1  ,  ( zb  I  7  1  ,w2b  )  ,(zb(8)  ,c2b  )  , 

4  (zb (9  I  ,s3b  1  >  ( zb (10)  ,*3bJ  ,(zb(  11  I  ,xb)  ,(zbM2  I  ,yb)  , 

4  (zb(13)  ,x1b)  ,  l  zb  C 1 4  l  ,x2b  l  ,(zb(l5 1  ,x3b  I  , 

4  lzbM6)  ,y1b)  ,(zbM7)  ,y2b  I  ,Izb(l8)  ,y3b  )  , 

4  ( zb ( 1 9  1  i  tana2b  )  , (zb (20 1  •  tana3b 1  •  ( zb  12 1  )  , t ana4b  )  , 

4  (zb (22  )  1 1 anaSb  I  ,  ( zb (23  I  ,  t  ana6b )  ,  1  zb ( 24  I  ,1b)  ,  ( zb (25  )  ,phib ) 
double  precision  coi  1  ,slp  (frct  ,c3  ,s4  ,w4  ,x4  ,y4  ,iana7  ,tana8  ■)  , 

4  h  ,phih  ,rtot  ,xtot  iZtot  ido 

equivalence  (z  (51  I  ,coi  1  I  ,(z(52)  ,slp)  ,(z(53)  ,frct  )  ,(z(54)  ,c3 )  , 
4  (z(55  1  ,s4  1  ,(z  (56  I  ,w4  I  ,(z(57  »  ,x4  )  ,(z(58  )  ,y4  1  , 

4  (z (59  1  ,  t ana7  )  ,  (z (60  )  ,  t ana8 1  .  (z (61  )  ,  1 1  , 

4  <z<62  )  ,h)  ,lz(63  )  ,phih)  , 

4  ( z  ( 64  I  ,rtot  I  ,  ( z  ( 65 1  ,xtot  I  ,  ( z  ( 66  )  iZtot  )  ,(z(67l  ,do  > 


double  precision  pi  .halfpi  , degrad  .raddeg  .zero  .one  , he 1 f 
integer*2  izero  , ione  ,i two 

common  /VCONST/  pi  ,hal fpi  .degrad  .raddeg  .zero  ,one  ,hal f  , 

A  i zero  ,  i one  ,  1 1  wo 

double  precision  delyk  ,  twod  ,hal fd  ,dsq 
common  /VANCH/  delyk  ,  t  wod  .ha  l  fd  .dsq 

double  precision  snphih  .csphih  .snafh  .csafh  .inefh  .scafh  .dsnph 
common  /VHDIR/  snph i h  .csphih  ,sna fh  .csafh  , t na fh  ,sca fh  .dsnph 

double  precision  sa  ,sb  ,ca  ,cb  ,vc0a( 6)  ,vc0b (6  I  , 

A  eex0  ,eez0  ,eey0  ,a0  .b0  ,phia0  ,phib0 
integer *2  icase 

common  /VSPID/  sa  ,sb  ,ca  ,cb  ,vc0a  .vc0b  . 

A  eex0  ,eez0  ,eey0  ,a0  .b0  ,phia0  ,phib0  . 

A  icase 

double  precision  vc0al 
equivalence  (vc0a(l  I  ,vc0al  ) 

integer *2  ivs 

double  precision  v0,vl  ,v2,f0,fl  ,f2,f,eps 
common  /VSEC/  v0,vl  .v2.f0.fl  . f 2  . f  ,eps  . i  vs 

i  n  t  eger*2  mi  ,i  ,  i  f  o  1 1  .ibis.i  sec  .nwae 
double  precision  zz ( 7 ) 

equivalence  (zb( 11  )  ,zz  )  ,  ( zb  1 1 8  )  .scafz  ,hal fdd  .temp  ,sl  ,nwaa )  , 

A  I  zb  ( 1 9  l  .esphin  .hddesp  ,rr  I  ,  (zb  ( 20 1  >ssa  1 

*t*m»«m«tM****m*t**»**«***mt*»*»*u*»»im*«**m»**»*m»* 
*  write!  10  .*  )  'CSSPR  '  .riot 
r-r lot 

epsr-r*1  0d-l0 

if  Iieps  eq  I  I  epsr-r*l  0d-4 

scaf  z-SECNT (cz l 

csphm-csefh*  (snphih+czttnefh  I /scafz 
hal fdd-hal fdtscafz 
hddcsp-hal fdd*csphin 
i emp-hddcsp*hddcsp-hal fdd*hol fdd 

s 1 -dmi nl ( dsqr  t ( sa*sa+ I emp  I  ♦ hddesp  .dsqrt (sb*sb*i emp )- hddesp ) 
do  100  i-l  ,7 


-4 

CM 


100 


ZZ( I  )-Z( l  I 
con i i nue 


ha-h 

sla-sl 

«*1a-(ca+cb)/sl 

c1a-c3 

s2a-8'1 

w2a-w4 

call  VCR I T0 ( 2  ,za > vc0a  I 

nwao-0 

if  (wla  li  zero  or  *2a  It  zero  1  n*aa-l 

ssa-s1a+s2a 
h0-ca+cb+s1*iH 
f -do 

eps-h0tl  0d-l0 
i  vs-0 

ha-h0*l  0d-5 

call  XSECVI2  .za  .vc0a  >ssa  ,vc0a(  ,n»oa  >ncb  ,zb  ,vc0b  , 

4  snafh  ,csafh  , inafh  ,scafh  ,2  >i  fai  I  I 
rr-dmax 1 (dminl (r  ,0  01*xa*0  99*dsqr t (ssa*ssa-do*do ) )  ,xa ) 

ha-h0 

cal  I  XSECVI2  ,za  ,vc0a  ,ssa  ,vc0ol  .nwaa  .neb  ,zb  ,vc0b  , 

4  snofh  .csafh  ,tnafh  .scofh  ,2  ,i  fai  1  ) 

r0-xa 

h  1  -ha 1 f*h0 
ha-hl 

cal  1  XSECV  (2  >za  >vc0a  ,ssa  >vc0ol  ,n«aa  >ncb  ,zb  .vc0b  , 

4  snafh  .csofh  , inafh  ,scafh  ,2  >i  fai  1  I 
r  1  -xo 

300  coni inue 

ha-hl - (r I -rr  1*  (hi -h0  )/ (r 1 -r0  I 
if  lha  le  zero)  ha-half*ht 

cal  I  XSECV12  >za  >vc0o  ,ssa  ,vc0al  ,n«aa  >ncb  >zb  >vc0b  > 

4  snafh  .csafh  , inafh  .scafh  ,2  ,i  fai  1  1 
h0-h1 
hi  -ha 
r0-r  1 
r  I  -xo 

if  (dabslrl  rrl  gi  eps 1  goto  300 


do  500  i-l  ,7 

z(  1  l-Z2( i ) 

500  continue 

call  VCR  I T0 (nca  ,za  ,vc0a ) 

hi -0  9d0*h0 

*  write (10,*)  h0,hl 
h-h0 

call  CPREP3 
call  CSSHP 
r0-r tot 

1  wr  i  te(  10  ,*  I  h0  ,r0 

h-hl 

call  CPREP3 
call  CSSHP 
r 1 -r tot 

write!  10  ,*  1  hi  ,r1 

n  i  t  -  1 
ibis-0 
i sec-0 

1000  continue 

,‘f  ?'  15  an2  (r0-r  I*  (rl  -r  )  It  zero  and  ibis  le 

ibis-0  iSec  eq  0  or  isec  9'  6,1  goto  1020 
i sec- i sec* 1 

h-hl - (r I -r I* (hi -h0  )/ (r 1 -r0  ) 
if  (h  le  zero)  h-hal f*hl 
goto  1 100 
1020  continue 

ibis-ibis+l 
i sec-0 

h-hal f* (h0+h1 I 
I  1 00  con  1 1 nue 

call  CPREP3 

call  CSSHP 

wr  i  tel  10  ,*  l  h  ,r  tot 

if  (dab8(rtot-r  1  It  epsr  I  goto  5000 

if  (nit  eq  100)  stop  110 

if  ( i b i 8  eq  0 )  goto  1 350 

if  ( (rtot-r  1*(r0-r )  It  zero)  goto  1370 


et  svs  f inal/t2for/csepr  forll 
subrou • i ne  CSEPR ( i eps ) 

************************************************************************ 
implicit  inteaer*2  ("I 
implicit  double  precision  (e-z) 

integer*2  teps 

integer*2  ileg.ist  ,nca  , neb  ,n«a  ,n*b  , iso  1  ,  ibrnch  ,uz  15  1 
double  precision  z(67 1  ,c*  ,cx  id  ,ta  .tb 

common  /VCLOB/  i  leg  >ist  ,nca  ,ncb  ,z  >cz  ,cx  ,d  ,ta  ,tb  ,nwa  ,nwb  , 

A  i so 1  .  i brnch  ,uz 
double  precision  zal  25  I  ,zb(25 I 
equivalence  (z ( 1  1  ,za(  1  1 1  . tz (26  I  ,zb( 1  1 1 

'  double  precision  ha  , ala »va  ,sla  ,»1a  , eta  ,s2a  ,*2a  ,c2a ,s3a  ,*3a  , 

A  xa  ,ya  ,x1a  ,x2a  ,x3a  ,y1a  ,y2a  ,y3a  , 

A  t  ana2a  ,  t  ana  3a  ,  t  anal a  ,  t  anaSa  ,  t  ana6a  ,  1 a  ,ph i a 
equivalence  (zal I  1  .ha)  ,(za(2>  >a)a  ,va)  . 

A  ( za 1 3 1  ,s  1  a  1  ,Ua(tl  ,*  1  a )  . I za ( 5 1  .eta)  , 

A  t  za  1 6 )  ,s2a )  ,  ( za  ( 7  )  ,«2a  l  >  ( za  ( 8 1  ,c2a )  . 

A  (za(9 1  ,s3a  I  ,  (za( 10 1  ,*3a  )  ,(za( 1 1 )  ,xa )  ,  (zal 12 )  ,va I  , 

A  (zal 1 3 )  ,x 1  a )  , lzo( 1 4 )  >x2a )  , (zal 15 )  ,x3a ) > 

A  (za  (  16  I  .yla)  ,(za(17l  ,y2a  I  ,(za(I81  ,y3al  , 

A  (zal  19  I  ,tana2a)  , ( za( 20  I  .tana3a)  >(za(2l  I  ,  iana4aJ  , 

A  (zal 22  )  >tana5a  I  ,  ( zal 23  )  ,tana6a  )  ,  ( zal 21  )  ,la  )  ,  I zal 25 )  ,phio ) 

double  precision  hb  .alb  ,vb  >stb  ,w1b  ,clb  ,s2b  ,»2 b  >c2b  >s3b  ,w3b  , 

A  xb  >yb  .xlb  ,x2b  ,x3b  ,y  lb  ,y2b  ,y3b  , 

A  t  ana2b  ,  t  ana3b  .  t  ana  4  b  ,  t  anaSb  .  t  ana6b  ,  1 b  ,ph i b 
equivalence  (zb( 1 1  ,hb  I  , ( zb ( 2  >  .alb  ,vb >  , 

A  (zb(3)  ,s1b)  ,(zb(41  ,*lb)  ,(zb(5)  ,clb)  , 

A  (zb(6 )  ,s2b  1  ,  ( zb ( 7  I  ,<*2b )  ,  ( zb ( 8 )  ,c2b )  , 

A  (zb (9)  ,s3b  1  ,  ( zb (10)  ,»3b  I  ,  ( zb ( 1 1  I  ,xb )  > ( zb ( 1 2 )  , vb )  , 

A  ( zb  ( 1 3 1  ,x  1  b  I  ,  ( zb 1 1 4  )  ,x2b  I  ,  ( zb  ( 1 5 1  ,x3b )  , 

A  ( zb  ( 1 6  )  ,y  1  b  )  ,  ( zb  M  7  1  ,y2b  )  ,  ( zb  (18)  ,y  3b  )  . 

)  A  (Zb  1 18 )  .  tana2b ) # (zb (20 )  ,  tana3b )  ,  I  zb  121 )  ,  tana4b I  , 

A  (zb (22  I  ,t anaSb )  ,  (zb (23  I  .teno6b I  ,  (zb (24 )  ,1b )  , izb(25 )  ,phib ) 
i  double  precision  coi  1  ,slp  ,frct  ,c3  ,s4  ,*4  ,x4  ,y4  ,tana7  ,tana8  ,1  , 

A  h.phih.rtot  ,xtot  ,ztot  ,do 

equivalence  tz (51  )  ,coi 1  1  , ( z (52  )  ,slp  I  , (z 153 )  ,frc t  )  > (z (54  )  ,c3 )  , 

A  ( z  (55  I  ,s4  1  ,(z  (56  )  ,»4  )  ,(z(57)  ,x4)  ,(z(58)  ,y4)  , 

A  (z(59>  , tana 7  1  , (z< 60)  , tana8)  ,(z(61 >  >1 )  , 

A  (z(B2)  ,hl  ,  ( z  (63 )  ,phih)  , 

A  (z (64 1  ,r tot  I  , <z(65 1  ,x tot  I  , (z (66 )  ,z tot  )  ,lz (67  )  ,do ) 


<1 

->4 


double  precision  pi  .halfpi  , degrad .raddeg  .zero  iOne ,hal f 
integer*2  izero  .tone  .1  two 

common  /VCONST/  pi  ,hat  f pi  >degrad  .raddeg  .zero  ,one  >hal f  , 
i,  t  zero  ,  i  one  ,  1 1  wo 

double  precision  delyk  ,twod  .hal fd .dsq 
common  /VANCH/  delyk  ,twod  ,hal  fd  idsq 

integer*?  iscopa  , iscopb >i tana  >i tanb ,i t  ,is 
double  precision  epsy  .gamma  ise 

common  / VCMPO/  epsy  .gamma  >se  > 1 scopa  .  i scopb  > i t  ana  > 1 1  anb  .it  > i s 
integer*?  iscop(2) 
equivalence  1 1 scopa  .  i scop  i 

double  precision  snphih  .csphih  .snafh  .csafh  .tnafh  .scafh  .dsnph 
common  /VHOIR/  snphih  .csphih  .snafh  .csafh  , tnafh  .scafh  .dsnph 

double  precision  sa  ,sb  .ca  ,cb  ,vc0a!6  >  ,vc0b  16  >  , 

&  eex0  ,eez0  .eey0  >a0  >b0  >phia0  >phib0 
integer *2  icase 

common  /VSP1D/  sa  ,sb  ,ca  .cb  ,vc0a  ,vc0b  . 

A  eex0  ,eez0  >eey0  >a0  >b0  ,ph  i  a0  ,ph  i  b0  , 

&  icase 

double  precision  vc0a1 
equivalence  (vc0a(l  I  >vc0a1  I 

integer *2  ivs 

double  precision  v0  ,vl  ,v2,f0,fl  , f 2  , f  ,eps 
common  /VSEC/  v0  ,vl  ,v2  > f 0  , f 1  , f 2  . f  .eps  ,ivs 

integer*2  nit  ,i  .ibis  .isec 

************************************************************************ 
*  or  i  tel  10,*)  'CSEPR'.rtot 
r-r tot 

epsr-r*l  0d-10 

if  lieps  eq  II  epsr-r*l  0d-4 

coll  CPREP1 

hi  -  lca-*-cb+c3+84*«M  1*0  2d0 

h0-0  9d0*h1 

h-h0 

call  CPREP3 


~4 

00 


wr  i  ie(  10  >* ) 
call  CSEHP(0 I 
r0-r tot 

wr  i  te(  10  .*  1  h0  >r0 
h-hl 

call  CPREP3 
wr i  tel  10  i*  1 
cal  I  CSEHP11 ) 
rl-rtot 

wri  tel  10  i*  1  hi  ,r1 
ni  t  -  1 

ibis-0 
i sec-0 

1000  continue 

if  (nit  gt  15  and  (r0-r  I* (r 1 -r )  It  zero  ond 
&  and  lisec  eq  0  or  isec  gt  61)  goto  1020 
ibis-0 
isec-isec+1 

h-hl-Crl-r  I*(h1-h0)/(r1-r0l 
if  (h  le  zero)  h-half*h1 
goto  1100 
1 020  con  t i nue 

ibis-ibis+1 
i sec-0 

h-hal f*(h0*h1 1 
1  1 00  con  1 1 nue 

coll  CPREP3 
wr  i  te  ( 10  ><  I 
coll  CSEHPMI 
wr  i  tel  10  i*  )  h  ,r  t o t 
if  (dabs(rtot-r  I  It  epsr )  goto  5000 
if  (nit  eq  1001  stop  110 
if  (ibis  eq  0)  goto  1350 
if  ( (r tot-r  )* 1r0-r  1  It  zero)  goto  1370 
h0-h 
r0-r  tot 
goto  M00 
1 350  con  1 1 nue 
h0-h1 
r0-r1 

1370  continue 


ibis  le  6 


et  svs  ( lnal/t2for/cssxzl  forll 
subroutine  CSSXZI 

implicit  mteger*2  (ml 
implicit  double  precision  (a-zl 

integer*?  t leg  . i st  ,nca >ncb  .nea  .n«b . t so)  .ibrnch  ,uz(S) 
double  precision  z(07  I  ,cz  .cx  id  ,ta  itb 

common  /VCLOB/  i  leg  ,ist  ,nco  ,ncb  ,z  ,cz  ,cx  >d  ,ta  ,tb  >nwa  <n«b  , 

&  isol  iibrnch  ,uz 
double  precision  za(25  1  ,zb<25 l 
equivalence  IzM  I  .za(  1  II  >(z (26 1  ,zb(  I  1 1 

double  precision  ha  ,ala  ,va  ,sta  ,«la  .cla  ,s2a  ,w?a  ,c?a  .s3a  ,*3a  , 

&  xa  ,va  ,xla  >x2a  >x3a  .yla  .y2a  ,y3a  , 

&  t  ena2a  .  t  ana3a  >  t  ana4a  >  t  anaSa  >  t  ano6a  ,  1  a  >ph i a 
equi valence  (za( I  I >ha I >(za(2 I >ata  .va I > 

&  ( za  ( 3 1  .s  1  a  l  i  ( za  (4  I  .» I  a  I  ,  ( za  ( 5 1  ,c  I  a  I , 

&  ( za ( 6 1  ,s2a  I  ,  ( za ( 7 1  ,«2a  I  ,  I za ( 8 )  ,c2a  I  , 

3  (za(9 1  ,s3a  l  .Izallfll  ,«3al  ,(za(  II  l  >xa  l  ,t  zaii  2  l  >yol  , 

4  ( za  ( 1 3 1  ix  I  a  I  ,  <  za  I  14 I  >x2a  l  .  ( za  ( 1 5 1  >x3a )  > 

4  (za(  161  ,y  la  I  ,(za(1  7  I  ,y2al  ,(za(  18)  ,y3a>  , 

&  t  za (10)  1 1  ana2a  I  ,  (za(20  )  ,tana3a I  ,  (za 121  I  ,  tana4a  I  , 

&  (za(22  l  >tana5a )  ,  (zo(23 I  ,  tana6a I  ,  (za 124 )  ,1a  I  ,  ( za( 25  )  >ph i a  I 
double  precision  hb  ,al b  ,vb  .sib  ,«lb  tc!b  ,s2b  ,»2b  ,c2b  .s3b  ,»3b  , 

&  xb  ,yb  ,xlb  >x2b  >x3b  iylb  ,y2b  ,y3b  , 

&  t  ana2b  .  t  ana3b  .  t  ana4b  1 1  ano5b  >  t  ana6b  ,  l b  ,ph i b 
equ i va I ence  ( zb ( I  I  .hb  I  .  ( zb ( 2  I  ,a 1 b  ,vb  I  , 

&  ( zb  ( 3 1  .sib)  ,(zb<4)  ,»lb  )  ,(zb(5)  ,clb)  , 

&  I  zb  (6 1  .s2b  I  .  ( zb  ( 7  l  ,*2b  l  .  ( zb  ( 8 )  ,c2b  I  , 

4  (zb  (9 1  ,83b  I  ,(zb!10l  ,*3b)  ,(zb(  11  I  ,xb )  ,(zb(l  2  )  ,yb  I  , 

&  ( zb (13)  ,xlb  I  , (zb(  M  i  ,x2b)  ,  tzb(  15 )  ,x3b  )  , 

&  (zbll6)  ,v!b>  , ( zb ( 1 7 1  ,y2b I  ,(zb(  18)  ,v3b)  , 

&  (zb  ( 19 1  >tana2b  I  ,( zb  1 20 1  ,  tana3b  l  ,(zb(2t  )  ,ter.a4b  I  , 

&  (zb (22 1  .tonaSb l  , (zb (23 1  ,t ona6b )  , (zb (24  )  ,1b)  > l zb (25  I  ,phib l 
double  precision  coi  1  ,slp  .fret  ,c3  ,s4  ,»4  ,x4  ,y4  ,iana7  , tana8  ,1  , 

&  h.phih.rtot  ,x t o t  .ztot  ,do 

equivalence  (z(51  I  ,coi  I  I  ,(z(52  I  >s  1  p  I  >(z(53)  , fret  1  , ( z (54  l  ,c3t  , 
4  (z(SS>  ,s4)  ,  <  z  ( 56 1  ,«4I  .  ( z  ( 57  I  ,x4  I  ,(z(58>  >v4  )  , 

&  (z(59>  ,  tana7 I  ,  (z(60)  ,  tanoS)  ,  ( z ( 6 1  I  ,1  I  , 

&  ( z  ( 62  I  ,h  I  >(2(63)  .phihl  , 

&  (z  (64  I  .rtot  I  ,tz(65  I  ,xtot  I  ,(z(66  )  .ztot  )  . ( z 1 67  I  ,do  I 
double  precision  xztot(2l 
equivalence  txztot ( I  I  ,xtot l 


I 


I-  I 


*  ,JSL 


double  precision  epsxz .xztru(2 1  .xzbas (2 1  ,hbas(2 ) .scrat 1 110) 
common  /VCSSXZ/epsxz  ,xziru  .xzbas  .hbas  .scrat I 
double  precision  xiru  ,ztru .xbas  >zbos  ,hbasx  .hbasz 
equi valence  (xztrult  I  >x  tru  1  ,lxztru(2) $z tru >  . 

&  ( xzbas ( I  )  .xbas I  .  ( xzbas ( 2 ) >zbas ) » 

&  (hbas ( I 1  ihbasx  I  ,  thbas ( 2  I  .hbasz ) 
double  precision  cospt  » smpt  #hhx  >hhz  >dh0  >dt0  »dhl  ,di  1  »dh2  »qi2 
equ i va I ence  ( sera  1 1 ( 1 1  >cosp t I  .  I  serai  I  121  >s i np i 1  , 

&  ( sera  1 1 ( 3 1  .hhx I  > ( sera  1 1 14 1  ihhz  1  > 

A  Iscrail  (51  ,dh0)  , (scrat 1  (6)  ,dt0l  . 

&  ( scrat 1(71  idhl I  ,  ( sera* 1 1 8  I >d  t  1  1 i 

A  (scrat 1 (91  ,dh2 I  .(scratl (10)  ,dt2> 

double  precision  pi  .halfpi  .degrad  .raddeg  .zero  .one  , ha  1  f 
integer *2  izero  ,ione >i two 

common  /VCONST /  pi  ,hal fpi  .degrad  .raddeg  .zero  .one  ,hal f  , 

&  i zero  ,i one  .i  two 

tttt$*tt}t?ttittitt*ttt*ttttt*t**t************************************** 

*  wnte(10,*l  'CSSXZ1  ‘  .xztot 
xtru-xtot 

ztru-ztot 

r  tot  -dsqr tlxtot*xtot>ztot*ztot I 
phih-datanlztot/xtot  I 
cosp t  -  -z  tot  /not 
sinpt-  x tot /riot 
epsxz-rtot*rtot*l  0d-20 

call  CPREP2 
call  CSSPR « 1  ) 

hhx-h*smpt 

hhz-  -htcospt 

*  wr i  te ( 1 0  ,*  ) 

*  write! 10  ,*  1  hhx  ,  hhz  , xztot 

hbas x -hhx 
hbasz-hhz 
xbas-xtot -xtru 
zbas-ztot-ztru 
dh 0-zero 

dt0-xbos*cospt ♦zbasZsinpt 


Oo 

N 


if  1dt0*dt0  le  epsxztl  0d12l  goto  600 

do  500  i-l  ,5 

dh2-  -h*dt0/rtot 

if  (i  gt  11  dh2-dh1 -d» 1  * Idhl -dh0 1/ tdt 1 -dt0 1 

hbasx-hhx+dh2*cosp  t 

hbasz-hhz+dh2*s lnp  t 

h-dsqr t (hbasx*hbasx+hbasz*hbasz 1 

phih-datan(hbasz/hbasx 1 

call  CPREP2 

call  CPREP3 

call  CSSHP 

»n  ie(  10  ,*  I  hbas  ixztot 
xbas-xtot -xtru 
zbas-ztot -ztru 
dt2-xbas*cospt  *zbas*sinpt 
if  1 i  eq  1 1  goto  300 

if  Idt2*dt2  It  (xbas*xbas+zbas*2bos )*1  0d-2l  goto  600 

dh0-dhl 

dt0-dt 1 

300  con  t i nue 

dh1-dh2 
dt 1 -dt2 

500  con  1 1 nue 


600  con  1 1 nue 
return 


i  ;y\ 


ei  svs  f inal/i2foc/cssxz2  for## 
subrouf me  CSSXZ2 

************************************************************************ 
implicit  integer*?  (0) 
implicit  double  precision  (a-zl 

integer  *2  ileg,ist  ,nca  ,ncb  .naa  ,nwb  > i sol  ,  ibrnch  ,uz  15  ) 
double  precision  z 187  )  icz  ,cx  ,d  , to  , tb 

common  /VGLOB/  i  leg  ,ist  ,nca  .neb  .z  ,cz  >cx  ,d  ,ta  ,tb  ,nea  ,nab  . 

A  i so 1  .ibrnch  ,uz 
double  precision  za(25  1  ,zb(25  ) 
equ i va I ence  I z ( 1  I  ,za  M  I )  .  I z ( 26  I  ,zb ( 1  )  1 

double  precision  ha  >a1a  ,va  ,sla  .ela  >c(a  ,s2a  .e2a  ,c2a  ,s3a  ,w3a  . 

&  xa  .ya  ,xla  .x2a  ,x3a  ,y  la  ,y2a  .y3a  , 

A  iana2a  ,tana3o  ,tana4a  ,  tanaSa  ,tana6a  ila  >phia 
equivalence  (za( 1  )  ,ha)  >(za(2)  >ala  ,va)  > 

A  (za(3)  .sla)  , (za(4)  .elal  .(za(5)  ■cla) » 

A  (za(6 )  ,s2a )  ,  (zat 7  )  ,w2a  >  i  (za(8  )  ,c2a  I  . 

A  (za(9)  ,s3a)  , (za( 10) ,e3a)  ,(za( 11 )  ,xa>  ,  Izoi 12 )  ,ya>  > 

A  ( za  ( 1 3  1  ,x  I  a )  ■  1  za  (  14  I  ,x2a  )  ,  ( za  ( 1 5  1  >x3a  )  , 

A  ( za 1 1 6 1  ,y 1  a )  ■  ( za (1 7  J  ,y2a  I  ,  ( za ( 1 8 1  ,y 3a  )  , 

A  <za(19l  ,tana2«l  >(za(20l  >tona3e)  ,(za(2t  >  >iena4a>  . 

A  ( za ( 22  )  1 1  ana5a 1  ,  ( za ( 23  l  ,  t  ana6a I  ,  I zo  1 24  )  ,1a)  ,  I zo 1 25 )  ,ph i a ) 
double  precision  hb  ,a1b  ,vb  ,slb  ,elb  >db  ,s2b  .a2b  ,c2b  ,s3b  ,s3b  . 

A  xb  >yb  ,xlb  ,x2b  >x3b  iylb  ,y2b  .y3b  , 

A  t  ana2b  ,  t  ano3b  ,  I ana4b  ,  t  ana5b  .  t  ona6b » l b  ,ph i b 
equivalence  (zbi 1  1  ,hb  I  ,  (zb (2  )  >atb  ,vb >  > 

A  C  zb  ( 3  )  .sib)  >(zb(4)  ,»lb>  .  ( zb  ( 5  I  ,clb)  . 

A  (zb(6>  .s2b  1  , ( zb 1 7 1  ,w2b  )  ,<zb(8>  ,c2b)  , 

A  <zb(9l  ,s3b)  ,  (zbl  10 1  ,«3b)  ,  l  zb  1 1 1)  ,xb )  ,  izbM  2 )  ,yb  >  . 

A  ( zb  ( 1 3 1  ,xlb>  ,(zbm>  ,x2b)  .(zbllS)  >x3b  I  , 

A  (zbl  16 )  ,y  1b»  .IzbM 7)  ,y2b)  .(zb (18)  ,y3b)  , 

A  ( zb  1 1 9 )  .  t  ana2b I  ,  ( zb ( 20  I  ,  t ona3b 1  ,  ( zb ( 2 1 )  ,  t analb )  , 

A  (zb (22 )  .tanaSb )  , (zb (23 1  >tona6b  )  , (zb(2^  )  . lb  )  , (zb (25 ) >phib ) 
double  precision  coi  1  .sip  ,frct  ,c3  .s^  ,x1  ,y4  ,tana7  ,tano8  ,1  , 

A  h.phth.rtot  ,xtot  ,ztot  ,do 

equivalence  (z<S1  I  ,cot 1  I  . (z (52  )  ,slp  )  . (z (53  >  .fret  )  >(z (54  I  ,c3 )  . 

A  (Z(SS)  ,84)  ,lz(50l  ,w4  I  ,(z(57  )  ,x4  )  ,(z(S8>  ,y4  )  , 

A  ( z ( 59  )  .  t ano7  )  ,  ( z ( 60  )  .  t ana8 )  ,  ( z ( 6 1 )  .1 >  . 

A  (z (62  )  .h)  .  ( z (63 )  ,phih )  , 

A  (z (64  I  ,r  tot  )  > (z (65  )  .x tot  )  . (z (66  1  ,z tot  )  .  (z 167 )  ,do I 
double  precision  xztot(2) 
equivalence  lx* tot ( 1  I  .x to t I 


00 


double  precision  pi  ,holfpi  .degrad  .raddeg  .zero  , one  , hoi  f 
integer*2  izero  .tone  ,t  two 

common  /VCONST/  pi  ,hol fpi  , degrad .raddeg  iZero  ,one  ,hol f  , 

&  i zero  > i one  ,  1 1  wo 

double  precision  epsxz  ,xz iru (2  I  .xzbos (2 )  .hbos I 2 )  .scroi 1 (1 0 ) 
common  /VCSSX2/epsxz  .xztru  , xzbos >hbos  ,scrat 1 
double  precision  xtru  ,ztru  .xbos  ,zbos  .hbasx  .hbosz 
equivalence  IxztruM  )  .xirul  .(xztru(2l  ,ztrul  , 

&  (xzbos ( I  1  ,xbas  )  , ( xzbos (2  I  >zbos  )  , 

A  (hbos ( I  I  , hbasx  I  ,  (hbos 12  I  ,hbosz 1 
doub 1 e  precision  dhmax  ,dhm i n  ,h i s  t ( 2 1  ,h i s  t  x  ,h i s  t  z 
equivalence  (scroi 1(1)  , dhmax  ,hisi 1 1 1  ,histx  )  ,  Idhmm  ,hist (2  I  .hist z I 
double  precision  delh(2  1  .delhx  .delhz  ,dhbx  ,dhbz 
equivalence  (scroi 1(31  .del  h  ( I  1  , delhx  ,dhbx  )  , ( delh (2 )  .delhz  ,dhbz ) 
double  precision  jac (2  ,2  I  ,j  1 1  ,j  12  ,j2l  ,j22 
equivalence  (scroi  1  (51  ,joc  ( 1  .1  I  ,j  1 1  1  , ( jac  ( 1  ,21  >j  1 2  )  , 

A  (jac(2  ,1  )  ,j21)  ,( jac(2  ,2  )  ,j22  ) 
double  precision  jne*H) 
equivalence  (jac.jnew) 
double  precision  temp  ,xzsqo  , del j 

equivalence  (serai  1(91  ,  temp  ,xzsqo )  .(scroi 1 (101  ,dei j  1 

double  precision  joldHI 
mteger*2  i  ,j  .k  ,m  t  >iqui  i  .i  jo 

*t*t*t*ttti*t**t*tt**t****tttt**t**t**t**tt**t***tt***t*t*****t***t*ttt* 

*  »r  i  te(  10  ,*  ) 

*  write! 10,*)  CSSXZ2' 

iqui 1-0 
i  jo-0 
m  t-l 

1 000  con  t ( nue 

*  write(10,*)  hbos  .xzbos 

xzsq-xbo8*xbos+zbostzbas 

if  (iquii  eq  1  or  xzsq  le  epsxz  I  goto  5000 

if  (mi  gi  10  and  xzsq  le  epsxz* I  0d1  >  goto  5000 

if  (mi  at  5  ond  xzsq  le  epsxz*1  0d8  and  xzsq  ge  xzsqo*holf) 

A  goto  5000 

if  lijo  eq  0  or  ijo  gt  5)  goio  1030 
i jo- i jo* 1 


1 


goto  1 800 
1030  continue 
i  jo-0 

if  (mt  eq  1)  goto  1050 

delhx- ( j 1 1 *xbas+ j 1 2*zbas  )*dsqr  t (j21*j21+j22*j22  >*det  j 
delhz- ( j2 1 *xbos+ j22*zbas )*dsqr  t  < j I l*j 1 1 *j I2*j 1 2 )*det  j 
************************************************************************ 

*  dhmex-h*1  0d-2 

*  dhmm-h*1  0d-8 

*  do  1020  i-l  ,2 

*  delhl i  l-dmoxl (dhmin  ,dmin1 ( dhmax  ,delh( ill) 

*  1 020  con  t i nue 

************************************************************************ 
goto  1100 
1050  continue 

delhx-h*1  0d-2 
delhz-delhx 
1 100  corn i nue 


H00 

* 

1500 


do  1 500  j  - 1  .2 

hist  (j  l-hbas<  j  1+delM  j  ) 
k-3-j 

hf s I ( k  1-hbas ( k  ! 

h-dsqr  r (htstx*htsix*htsiz*histz) 

ph i h-da  t on ( h  t  s t  z/h  t  s  t  x  ) 

coll  CPREP2 

call  CPREP3 

call  CSSHP 

do  1 400  i-1  ,2 

jac< i  ij  I- ( xz t ot ( i  )-xztru( i  )-xzbas 1 1  )  )/delh ( j  ) 
corn inue 

write(10,*)  delhl  j  1  .xztot 
corn inue 


if  (nit  eq  I  I  goto  1625 
do  1620  i-l  ,4 

if  ( dabs ( one — j  new (i  1/jold(i  1)  gt  1  0d-2)  goto  1625 
1620  continue 

i  jo- 1 

1625  continue 

do  1630  i-l  >4 

joldl i )-jne*( i  1 
con  t i nue 


1630 


det j-jl 1*j22-jI2*j2I 

*  wri tel  10  ,* )  jac  ,dei j 

*  writell0,«) 

t  1  and  detj  eq  zero  and  xzsq  le  epsxz*1  0d8  1 

if  < i qu i t  eq  I )  goto  2000 
temp-j 1 t 
jl l-j22/det j 
j22-temp/det j 
j!2-  -jt2/detj 
j2l-  -j2t/detj 

1800  continue 

dhbx-j 1 1 *xbas+j I2*zbas 
dhbz-j21 *xbas+ j22*zbas 
temp-one 

if  (dhbx+dhbx  gt  hbasx )  temp-hbasx/ tdhbx  +  dhb 
hbasx-hbosx - 1  emp*dhbx 
hbasz«hb<as2-  temp*dhb2 

2000  continue 

h-dsqr  t <hbasx*hbasx+hbasz*hbasz 1 

phih-datan(hbasz/hbasx I 

call  CPREP2 

coll  CPREP3 

call  CSSHP 

xbas-xtot-xtru 

zbas-ztot-ztru 

xzsqo-xzsq 

ni t -ni t  +  1 

goto  1 000 

5000  continue 
return 
end 


i f  (ni t  g 
&  i qu i t - 1 


V 


00 

r 


et  sys  f mol / t2for/csexz 1  fortt 
subroutine  CSEXZI 

************************************************************************ 

implicit  integer *2  1«) 
implicit  double  precision  <a-z) 

i nt eaer*2  i leg  ,  i s  t  ,nca  ,ncb  ,n*a  ,nwb  ,  i so  1  » i bench  ,uz (5  I 
double  precision  z(67  1  ,cz  ,cx  ,d  ,ta  ,tb 

common  /VGLOB/  i  leg  ,  i  s  f  ,nca  ,ncb  ,2  ,cz  ,cx  ,d  >t  a  ,  t b  >nwa  ,nwb  , 

&  i sol  .ibrnch  ,uz 
double  precision  za(25  I  ,zb(25  I 
equivalence  (z ( 1  1  ,za( 1  II  ,  tz (26  I  ,zb( I  I  > 

double  precision  ha  ,ala  ,va  >sla  ,*la  ,cla  ,s2a  ,#2a  ,c2a  ,s3a  ,w3a  , 

A  xa ,ya  ,xla  ,x2a  ,x3a  ,y la  ,y2o >y3a  , 

A  t  on a2a  .  t  ana3a  ,  t ano4a  ,  t  anaSa  ,  t  ana6a  > 1  a  ,ph i a 
equivalence  izaM  I  ,ha  1  ,(za(2)  ,a!a,val  . 

A  1  za  ( 3  1  ,s  1  a  l  ,  ( za  M  1  ,w  1  a  )  ,  ( za  1 5  1  ,c  I  a )  , 

A  ( za (6  I  ,s2a )  ,  (za( 7  )  ,w2o  I  ,(zo(8  I  .c2a )  , 

A  I  za  (9  I  ,s3o  I  ,  l  za<  10  I  ,w3a  I  ■  (zal  1  1  )  ,xa  I  ,  IzaM  2  )  ,ya  I  , 

A  (za  1 1  3  I  ,x  1  a  I  ,  ( za  I  14  1  ,x2a  I  ,  (za  ( 1 S  I  ,x3a  1  , 

A  (za(16l,y(ol,(za(l7)  ,y 2a 1  ,  (za( 18 )  ,y3a )  , 

A  (za( 19  t  ,  tana2a  )  ,  (za(20  1  ,tona3a I  ,  (za (21 )  ,tana4a )  , 

A  (2a(22  >  jtana5a )  ,  (za(23  I  itana6a  I  ■  ( zo (24  l  ,lo  )  , l zal 25  )  ,phia I 

double  precision  hb  ,alb  ,vb  ,s1b  ,w1b  .ctb  >s2b  ,*2b  ,c2b  ,sSb  ,*3b  , 

A  xb  ,yb  ,x  1  b  ,x2b  ,x3b  ,y  I b  ,v2b  ,y 3b  , 

A  t  ana2b  ,  t  ana3b  ,  t  ana4b  ,  t  ana5b  ,  t  ona6b  » l b  ,ph i b 
equ i vo 1 ence  ( zb ( I  I  ,hb  1  ,  ( zb ( 2  I  ,a I b  , vb  >  , 

A  ( zb  ( 3  I  ,s  I  b  I  ,  ( zb  ( 4  I  ,w  I  b  l  ,  l  zb  ( 5  I  ,c  1  b  )  , 

A  ( zb  (6  I  ,s2b  I  ,  l zb l 7  )  ,w2b  I  ,(zb(8l  ,c2b  )  , 

A  (zb <9 1  ,s3b  I  , (zb ( 10 1  ,*3b  1  , (zb ( 1 1  J  ,xb  )  ,  (zb ( 1 2  )  ,yb )  i 
A  (zb  ( 1 3  I  ,x1b  )  ,  (zbl  14  I  ,x2b)  ,(zbM5)  ,x3b)  , 

A  (zbl  16  I  ,y  I  b  I  ,  l  zb  117)  ,y2b)  ,(zb(18)  >y3b)  , 

A  ( zb ( 1 9  I  ,tana2b)  ,  I  zb (20 1  ,tono3b)  ,(zb(2l 1  ,tana4b)  , 

A  (zb (22  1  ,ianaSb  I  i(zb(23  )  ,  tano6b  >  .  (zb (24  I  ,1b  >  , i zb (25  I  ,phib  1 

double  precision  coi  1  ,slp  ,frct  ,c3  ,s4  ,w4  ,x4  ,y4  ,tono7  ,tana8  ,1  , 

A  h,phih,rtot  ,xtot  ,ztot  ,do 

equivalence  ( z (51  1  ,co 1 1  1  ,  ( z (S2  I  ,s Ip  1  , 1 z (53  )  ,  fre  t 1  ,  (z (54 1  ,c3 )  , 

A  (2  (SSI  ,s4!  ,(z(56l  ,«*4I  ,(z(57)  ,x4  )  ,(z(58)  ,y4  )  , 

A  <z(59 )  ,  tana 7  )  ,  (z (60 1  ,iana8 )  ,  (z (61 )  ,1 )  , 

A  (2  (62  1  >h  1  > l z  (63 )  ,phih)  , 

A  (2(64)  ,r  t  ot  )  , (z  165  I  ,x  tot  I  ,  (z  (66  I  ,z  t  o  t  I  ,  ( z  1 67  )  ,do  ) 
double  precision  xztot(2l 
equivalence  (xz tot ( I)  ,x tot  I 


t 


double  prec i s i on  eps«  ,«.ru(2»  ,«besl2)  ,hbes(2)  .scra.l  M0> 
common  /VCSSXZ/epsxz  .xztru  .xzbas  ,hbas  .sera 1 1 
doub 1 e  prec ision  x i ru  ,Z  t ru  ,xbas  .zbas  .hbasx  .hbasz 
equivalence  (xzirull  I  .xirul  .lxz»ru(2> »z  ru  . 

A  ( xzbas 1 1  I  ,xbas  )  .  I xzbas 12 )  .zbas )  > 

A  (hbas 1 1 I  .hbasx )  ,  thbasl2  )  .hbasz i  ,dh2.di2 

double  precision  cospr  ,s  i  np  t  ,hhx  ,hhz  ,dh0  ,di0,dhl  >dti  .onz.oiz 
equivalence  (scratl  (I  )  .cospt  1  '  2  ,s  1  P  ’ 

&  (scratl (3)  ,hhx  I  .(scratl  Ml  .bhz  , 

A  (sera 1 1  (5)  ,dh0  1  .(scrai  I  6  .dt0  . 

A  (scratl (7)  ,dhl  I  .(scratl (81  ,dt I  I  , 

A  (scratl (9)  ,dh2 l  .(scratl (10)  .dt2) 

double  precision  pi  ,hal fpi  .degrad  -raddeg  .zero  .one  .half 

i nieoert2  izero  none  >1  iwo  .  f 

common  /VCONST/  pi  .bal fpi  .degrad  .raddeg  .zero  .one  ,hal f  , 

A  izero  ,  tone  .  i two 

;,„**,***»***«*«************************************* 

*  wn  tel  10  ,*  )  -CSEXZI  '  ,X2  tot 

x  tru-x  tot 
Ziru-Zioi 

rtot-dsqrt (xtot*xtot+Ziot*ZtOt 1 
phih-datan(ztot/xtot I 
cospt-  -ziot/riot 
smpt-  x  tot /riot 
epsxz-r tot*rtot*l  0d~20 

call  CPREP2 
coll  CSEPRd  > 

hhx-h*smpt 

hhz-  -htcospt 

*  wr  i  te  ( 1 0  i*  I 

*  «ritell0.*l  hhx  ,hhz  ,xz  tot 

hbasx-hhx 
hbasz-hhz 
xbas-xtot -xiru 
zbas-ztot -ztru 
dh0-zero 

dt0-xbas*cosp t ♦zbasxs inpt 


! 


if  (dt0tdt0  le  epsxztl  0dl2)  goto  600 

do  500  i -I  ,5 

dh2-  -h*dt0/rtot 

if  (i  gi  1)  dh2-dh) -dt 1  * (dhl -dh0 )/ (dt 1 -dt 0 ) 

hbasx-hhx  +dh2*cosp t 

hbasz-hhz+dh2*s i np  t 

h-dsqrt (hbasxthbasx+hbaszthbasz ) 

phih-datanlhbasz/hbasx I 

call  CPREP2 

call  CPREP3 

nr i  tel  10  i*  1 

cal  1  CSEHPl I  ) 

•nieM0,t)  hbasixztot 
xbas-xfot-xtru 
zbas-ztot-ztru 
dt2-xbas*cospt  +zbas*sinpt 
if  ( i  eq  I  I  goto  300 

if  (dt2*dt2  Tt  ( xbastxbas+zbastzbas  I* I  0d-2)  goto  600 

dh0-dhl 

dt0-dt I 

300  continue 

dhl -dh2 
dt  l-dt2 

500  com  inue 


600  cont inue 
return 


et  svs  f inal/t2for/csex22  forM 
subrout  me  CSEX22 

************************************************************************ 

implicit  integer*2  (») 
implicit  double  precision  te-zl 

mt eaer*2  I  leg  ,ist  ,nco  .neb  ,n»a  ,n»b  ,  i  so  I  .ibrnch  ,uz (S ) 
double  precision  z(67  I  ,cz  >cx  ,d  .la  >tb 

common  /VCLOB/  i  leg  >ist  .nca  ,ncb  ,z  ,cz  ,cx  ,d  .to  >tb  ,n«ra  ,n»b  , 

A  i sol  .ibrnch  ,uz 
double  precision  za(2S 1  .Zb (25 1 
equ i vo 1 ence  ( z ( I  )  ,zo ( I  11  ,  ( z ( 26 )  .zb <1 1 1 

double  precision  ho  .olo  >vo  .slo  .*ta  »clo  ,s2o  .*2a  ,c2o  ,s3o  ,w3o  . 

&  xo  ,yo  .xlo  ,x2a  ,x3o  .yto  ,y2o  ,y3a  . 

&  i  ano2a  .  t  ono3o  ,  t  ono'la  .  t ono5o  .  t  ono6o  ,  1  o  ,ph  i  o 
equi valence  (zo( 1  )  .ho )  , l za(2 )  .ala  .va 1  . 

&  (za(3l  .slo)  ,(zaM)  ,«la)  ,(za(5)  .clo)  > 

&  lza<6)  ,s2al  ,(za(7)  ,«2a  1  ,(za(8)  ,c2a  1  , 

A  ( za 19  )  ,s3o  I  ,  (za( 10  )  ,*3a I  .  (za( 1 1 1  ,xa 1  , 1 za( 1 2 )  ,val , 

A  (za(13l  .xlal  .(zalHI  ,x2a)  .(zallS)  ,x3al  , 

A  (hoM6  l  ,y  la  l  ,  <za(  I  7  1  ,y 2a  1  ,(za(  18  1  ,y3a  l  , 

A  (20(19)  , i ana2o )  , 1 20(20)  .tona3a)  ,(za(21 l  .tana^a)  . 

A  (20(22)  .tanaSal  .(za(23l  .tana6o)  ,lza(2*l  .la)  ,  1 2a  1 25)  , phial 
double  precision  hb  ,a lb  >vb  ,s lb  .«* lb  ,c I b  ,s2b  ,w2b  .c2b  ,s3b  ,w3b  . 

A  xb  .yb  .xlb  ,x2b  ,x3b  ,y  1b  .v2b  .v3b  . 

A  t  ano2b  ,  t  ano3b  ,  t  ona^b  ,  t  ano5b  .  t  ano6b  ,  1 b  .ph i b 
equivalence  (zb ( I  I  .hb  )  ,  (zb (2  I  .alb  ,vb  )  . 

A  (zb( 3  1  ,s  1  b  )  , ( zb M  I  ,wlb)  ,(zb(5)  ,clb)  , 

A  ( zb  ( 6  )  .s2b  )  ,  ( zb  ( 7  1  ,«2b  )  ,(zb(8)  .c2b  )  , 

A  (zb (9 )  ,s3b  I  ,(zb( 10  )  >w3b  1  , (zb( I  1  )  .xb 1  ,  lzb( 12 )  ,vb )  . 

A  (zb(13)  .xlb)  ,lzb(H)  .x2b  1  ,(zb(IS)  .x3b)  , 

A  (zb  ( 16  I  .ylb)  .(zb(17)  ,y2bl  ,(zb(18)  .y3b)  , 

A  (zb( 19  I  >tano2b  I  .(zb (20  1  .tana3b 1  ,  (zb (2) )  .tanalb )  . 

A  (zb (22  )  ,tono5b 1  , (zb(23  1  .tano6b 1  , (zb I2<  >  , lb )  ,  (2b 1 25  )  .phib 1 
double  precision  coi  1  .sip  ,frct  .c3  ,s^  .<*4  .x^  >y4  ,tona7  , tanaS  ,1  , 

A  h  ,phih  .riot  ,xtot  .ztot  ,do 

equivalence  (z (51  )  ,co 1 1  1  ,  ( z (52 )  .sip)  ,  (z (53  )  .fret  1  ,  ( z (5i )  >c3 1 > 

A  (z(5Sl  ,s4)  ,(2(56)  ,w1)  ,(z(57)  ,x4  |  ,tz(58)  ,y*  I  . 

A  (z (59  )  .  tano7  1  ,  <  z (60 1  ,  tanaS )  .  ( z (61 1  ,1 1 > 

A  ( z  ( 62  )  .hi  ,  ( z  ( 63  )  .phihl  , 

A  (z (64  1  ,r  to t  1  , (z (65  I  ,x  to t  )  ,(z(66)  ,z  to t  )  ,  Iz (67 )  ,do ) 
double  precision  xztot(2) 
equivalence  (xztot ( I  1  .xtot I 


i  r 


I 

double  precision  pi  ,hal fpi  .degrad  ,raddeg  .zero  .one  .hoi f 
integer *2  izero  , tone  ,i two 

common  /VCONST/  pi  ,he! fpi  .degrad  .raddeg  .zero  .one  ,hal f . 

&  i zero  .  i one  .  1 1  wo 

double  precision  epsxz ,xz trol2 1  .xzbas (2 l  ,hbas <2 l  .scrat H 101 
common  /VCSSXZ/epsxz  ,xz tru  ,*zbas  ,hbas  .serai t 
I  double  precision  xtru  .ztru  ,xbas  .zbas  .hbasx  .hbasz 

equivalence  (xztrufl  I  .xtru)  ,(xztru(2)  .ztru)  , 

&  l xzbos 1 1  )  ,xbos )  .  ( xzbas ( 2  I  >zbos I . 

&  Ihbasll )  .hbasx I  , (hbas(2l  , hbasz 1 
double  precision  dhmax  ,dhmm  ,h is  i  (2  I  >ht s  t x  ,ht s  1 2 

equivalence  I  sera  1 1(1)  .dhmax  ,h  i  s  t  ( I  )  .histx  )  .Idhmm  .hist  (2)  ,h»stz  ) 
double  precision  delh(2)  .delhx  .delhz  ,dhbx  ,dhbz 

equ i valence  I scrat 1(31  ,de lh ( 1  I  ,de Ihx  .dhbx  )  ,  ( de I h ( 2 )  ,de 1 hz  ,dhbz ) 
double  precision  jac(2  ,2  )  .j  f 1  .j 12  ,j21  .j22 
equivalence  ( scrat  1  (51  ,jac ( I  .1  I  ,j  1 1  )  .( jac  1 1  ,2  1  , j ' 2  I  , 

&  l  jac  (2  ,1  )  .j21  1  ,  ( jac  (2  ,2  1  ,j22  1 
double  precision  jnewMI 
equivalence  Ijac.jnew) 
double  precision  temp  .xzsqo  .det j 

equivalence  ( scrat 1(91  .  t emp  .xzsqo )  ,  (scrat I ( 1 0  I  ,de  f  j I 

double  precision  jold(4> 
integer*2  i  .j  ,k  .nit  .iquit  ,ijo 

************************************************************************ 

*  wr  i  te  ( 10  .*  > 

*  wr i tel  10  ,*  )  'CSEXZ2 ' 

i qu i t -0 
i  jo-0 
m  t-1 

1000  continue 

*  wri te( 10 .* ) 

*  write!  10.*)  'ITER'.nit 

*  write!  10,*)  hbas  .xzbos 

xzsq-xbos*xbos+zbos*zbas 

if  (iquit  eq  l  or  xzsq  le  epsxz)  goto  5000 

if  (nit  gt  10  and  xzsq  le  epsxz*1  0d4 )  goto  5000 

if  (mt  gt  5  and  xzsq  le  epsxz*!  0d8  and  xzsq  ge  xzsqo*hol  f ) 

&  goto  5000 


•a 

ro 


if  (l jo  eq  0  or  i jo  gt  SI  goto  1030 

I JO-lJO*l 

goto  1800 
1 030  con  1 1 nue 
i  jo-0 

if  (nit  eq  I)  goto  1050 

delhx- ( j 1 1 *xbas+ j 1 2*zbas )*dsqr t ( j21 * j2l ♦ j22*j22 )*det  j 
delhz- ( j21 *xbas+ j22*zbas  )*dsqr t ( j II *j 1 1 +j 12* j 1 2 l*det j 
************************************************************************ 

*  dhmax-h*1  0d-2 

*  dhmm-h*1  0d-8 

*  do  1020  i -I  ,2 

*  de 1 h ( i  I  -d max  I ( dhm in  ,dm i n I ( dhmax  ,de 1 h 1 1  ) ) ) 

*1020  continue 

****************************************************************** ****** 
goto  1100 
1 050  con  1 1 nue 

delhx-h*!  0d-2 
delhz-delhx 
1  100  com  i  nue 


do  1500  j-l ,2 

hist ( j I -hbas ( j I *de 1 h ( j I 
*-3~  j 

hist f  h I -hbas ( k  I 

h-dsqrt (htstx*htstx+htstz*htstz) 
phih-datan(htstz/htsix  I 
call  CPREP2 
coll  CPREP3 

*  wr  i  te ( 1 0  >*  I 
cal  1  CSEHP( 1 ) 
do  1 100  i-l ,2 

jac ( t  »j I- (xz to» ( i l-xzirul i  l-xzbos 1 1  )  i/delh( j ) 
M00  continue 

*  wnteM0.*)  delhl  j  )  ,xztot 

1 500  don  1 1 nue 

if  (mt  eq  1  I  goto  1 625 
do  1620  i-l  .4 

if  (dabs ( one -j new ( i  )/jold( i I )  gt  I  0d-2>  goto  1625 
1620  cont i nue 

i  jo- 1 

1625  continue 


do  1 830  i-l 

joldl i 1* jnew ( i I 
I  coni inoe 

del j“ j • 1  * j22- j 1 28 j21 
wr i tel  10  >8 1 

•r  i  tel  10  >*  >  jac>detj  ____ 

»f  Imi  gi  1  and  deij  eq  tero 

A|f'?iqu»i  eq  1>  goio  2000 
temp^j 1 1 


xzsq  le  epsxz81  0d8l 


j11-j22/dei j 
j22-iemp/det j 
j 1 2-  -j12/detj 
j21 -  -j21 /del j 

1 800  con  1 1 nue 

dhbx- j 1 1 8xbas+ j 1 2*zbos 

dhbz-j21 8xbas+ j228zbas 

1  T"?dbbx+dhbx  gi  hbasx  l  lemp-hbasx/ (dhbx+dhbx  ) 

hbosx-hbasx- teroptdhbx 

hbasz-hbasz- iemp*dhbz 


2000  con i i nue 

h-dsqr i (hbasx*hbasx+hbosz*nbasz ) 
Dhih-daianlhbosz/hbasx  ) 

call  CPREP2 
call  CPREP3 
8  wr  i  ie  ( 10  i*  1 

coll  CSEHP11 l 

xbos-xioi-xiru 

zba8-zioi-ztru 

xzsqo-xzeq 

nlt«nii*l 

go  t  o  1 000 

5000  coni  I nue 
return 
end 

* 


-0 

4- 


I  t.5 


ei  sys  f inal/t2for/cepslv  forM 
subroui me  CEPSLV 

tttt*tt**t**tttt***»***********tt*ttt*tt******t**ttt***ts**tt*****t***** 
implicit  integer *2  (»l 
implicit  double  precision  (a-zl 

integer *2  i leg  ,is  t  ,nca  •neb  ,n«a  ,n*b  , i sol  , ibrnch  ,uz 15  ) 
double  precision  z 167  1  ,cz  ,cx  ,d  •  t a  , tb 

common  /VCLOB/  i  leg  •  i s  t  ,nca  ineb  ,z  ,cz  .ex  ,d  , t a  , t b  ,n*a  ,n»b  , 

4  i sol  .ibrnch  ,uz 
double  precision  za(25 )  .zb (25  I 
equivalence  (z( 1  )  ,ze< 1  )  I  > ( z < 26  I  .zbf 1  )  ) 

double  precision  ha  ,a1o  ,va  .sla  ,*la  .cla  .s2a  ,*2a  ,c2a  ,s3a  ,»3a  , 

4  xa  ,ya  ,x1a  •  x2a  ,x3a  ,y  la  .y 2a  >y3a  > 

&  t  on a2a  •  t ana3a  ,  t  anala  ,  t  ana5a  ,  t  ana6a  ,  I a  >ph t  a 
equivalence  (zaM  I  ,ho )  i(za(2)  .olo.va)  • 

&  ( za  ( 3  I  ,s  1  a  1  >  ( za  ( i  I  .«*  1  a  )  ,  ( za  ( 5  )  ,c  I  a  )  . 

4  ( za  ( 6  I  ,s2a )  •  ( za  ( 7  I  ,»2a  I  ,  ( zo  ( 8  I  .c2a  1  • 

&  ( za(9  l  ,s3a )  ,  ( za  ( 10  1  .w3a  1  >  ( za  (11  )  ,xa  )  .  I  za  1 1 2  1  ,ya  )  , 

4  C za *15)  ,x  la  l  ,(za(  M  1  .x2a  l  •  l za(  15  )  ,x3a  )  . 

4  (za( 16  )  .y la  )  ,( za( 1 7  !  ,y2a  I  ,  <za< 18  I  ,y3a  >  , 

4  Izal 19)  ,tana2a)  ,lzal20l  .tana3a)  ,lza(2l )  ,i  anala)  , 

4  ( za ( 22  i  1 1 ano5a )  ,  I za ( 23  I  ,  t  ano6o )  ,  t  zo 1 21  i  ,1a)  ,  I za  1 25  )  ,ph i a ) 
double  precision  hb  >alb  >vb  .sib  ,«lb  .clb  ,s2b  ,w2b  ,c2b  >s3b  ><*3b  . 

4  xb  ,yb  ,xlb  ,x2b  ,x3b  .ylb  ,y2b  .v3b  , 

4  t  ano2b  .  t  ana3b  ,  t  analb  .  t  ana5b  .  t ano6b  .  I b  .ph i b 
equivalence  ( zb  II  )  .hb  )  ,  ( zb (2 )  .alb  ,vb )  . 

4  ( zb  ( 3  1  ,s  I  b  I  .  ( zb  <  1 )  ,w  I  b  I  ,  I  zb  I  5  )  ,c  I  b  )  . 

4  (zb (6)  ,s2b  )  , ( zb ( 7  )  ,»2b  I  ,(zb(8)  .c2b)  , 

4  (zb(9)  ,s3b  I  ,  ( zb  ( 1 0  )  ,«3bl  ,(zb(ll  )  ,xb  I  ,(zbll2)  ,yb)  , 

4  «zb (131  ,xlbl  .<zb(H  )  ,x2b  )  ,(zb<  15)  ,x3b  )  , 

4  ( zb  ( 1 6  )  ,y  I  b  1  ,  ( zb  1 1  7  I  ,y2b  )  .  ( zb  ( 1 8  )  ,y  3b  )  , 

4  ( zb ( 1 9 )  1 1  ana2b )  .  ( zb ( 20 )  ,  t  ona3b )  ,  I  zb ( 2 1  )  .  t analb )  > 

4  (zb (22  I  ,tano5b I  .  (zb (23  I  ,tona6b I  , (zb  121 1  ,1b)  ,  (zb (25  )  ,phib I 
double  precision  coi  1  .sip  ,frct  ,c3  ,s1  ,t*1  >x1  ,y1  ,tana7  ,tano8  .1  , 

4  h.phih.rtot  .xtot  ,ztol  ,do 

equivalence  ( z (51 )  >coi I  I  .  ( z (52 l  .sip)  .  I  z (53  )  ,  fre t  )  ,  (z (51 )  >c3  )  , 

4  (z (55  )  .si  I  .  (z  (56  )  ,w1 1  .  ( z ( 57  )  ,x1 )  ,( z  (58  )  ,yl )  , 

4  (z (59  I  ,  tano7  )  ,  ( z (60 )  ,tono8 )  .  (z (61 )  .1 )  . 

4  (z  (62  I  ,h)  ,(z(63  )  .phihl  , 

4  (z (61 1  ,r  tot  I  , (z (65  >  ,x  tot  I  , (z (66  I  ,z  t ot  I  . ( z 167 )  ,do ) 
double  precision  pi  .halfpi  .degrad  .roddeg  .zero  .one >hol f 


integer *2  izero  ,ione »i two 

common  /VCONST/  pt  ,hal fpi  .degrad  .roddeg  .zero  .one  ,hal f  , 
&  izero  ,ione  , 1 two 

doub 1 e  prec i s i on  t  na  f  ,ph 1 f 
common  / VOfLR/  tnaf.phif 

double  precision  delyk  .twod  ,hal fd  ,dsq 
common  /VANCH/  delyk  .  1  mod  .half d  ,dsq 

integer*)  ctitleMM) 
common  /TITLES/  ctitle 

integer*)  cdatim(IG) 
common  /OATIME/  cdat im 

mteger*l  cvarm(172) 
common  /VARIN/  cvarm 

real  I  1  a  ,  1/ b  ,  1  1  ,hha  ,hhb  ,hh  . 

A  xx  I  a  .xx 3a  ,xx5a  .xx  I  b  .xx3b  .xxSb  ,xx7  ,xx8  . 

A  yy la  ,y y3a  .vv5a  .yy I b  .yy3b  ,yySb  ,yy 7  ,yy8  , 

A  zzla  ,zz3a  ,zz5a  ,zzlb  ,zz3b  .zz5b  .zz 7  ,zz 8  . 

A  aela  ,aa2a  ,oa3a  ,aa4a  ,oo5o >aa6a  , 

A  aalb  ,aa2b  ,aa3b  ,aaAb  ,aa5b  ,aa6b  ,aa7  ,oa8  . 

A  wla  .vw2a  ,w3a  .vvla  ,w5a  .vv6o  . 

A  w)b  .w2b  .w3b  .vvAb  .wSb  ,vv6b  ,vv7  ,vv8  > 

A  1 1  la  .i  1 2a  .t  t3a  ,t  Ha  .t  tSa  ,t  t6a  , 

A  1 1 1  b  ,  1 1 2b  ,  1 1 3b  .  t  Mb  ,  1 1 5b  .  1 1 6b  .  1 1  7  , 1 1 8  > 

A  ddo  >dda  .ddb  . 

A  af.afdir.afa  .adir  ,ofb  ,bdir  , 

A  sslp  .co i  la  >co i  lb 
integer*2  iisol.iibrn 

common  /VAROUT/  lla.llb.il  ,hha  ,hhb  ,hh  , 

A  xxla  >xx3a >xx5a  .xxlb  .xx3b  >xx5b  .xx7  ,xx8  , 

A  yyla  >yv3a  .yvSa  .yylb  .yy3b  .yySb  .yy7  ,yy8  . 

A  zzla  .zz3a  .zzSa  .zzlb  .zz3b  >zz5b  ,zz7  ,zz8  . 

A  aala  >aa2a  ,aa3a  .ooAa  ,aa5a >aa6a  , 

A  aalb  .aa2b  >aa3b  .aalb  >aa5b  >aa6b  ,aa 7  ,aa8  , 

A  vvla  >vv2a  ,vw3a  .wAo  .vvSa  .w6a  . 

A  wlb  >w2b  .w3b  twAb  .w5b  .w6b  .w7  .««8  . 

A  1 1  la  ,t  t2a  .t  »3a  ,t  He  .t  tSa  .t  t8a  . 

A  1 1 1  b  ,  1 1 2b  .  n  3b  ,  1 1 4b  ,  1 1 5b  ,  1 1 6b  .  1 1 7  , 1 1 8  , 


&  ddo  ,dda  ,ddb  , 

&  af  ,afdir  ,afa  ,adir  ,afb  ,bdir  , 

&  S3 1  p  >co  1 1  a  >co  ilb> 

&  1 1 so  1  > 1 1 brn 

real  par out (84) 
equ i va I ence  ( I  I  a  ,parou f  ) 

integer* I  cvarg(240) 
common  /VARC/  cvarg 

integer*!  cunkno(12l 
common  /UNKNOV/  cun k  no 

integer*!  cqropiMI) 
common  /GROPT/  cgropt 

integer*!  cgrp2l (218  I  ,cgrp22!82  I 
common  /GRP2CN/  cgrp2l  .cgrp22 

integer  *2  i  ,nc  ,  iof  f  ,iS,iy,ic,il  ,  ip  ,iv 

dimension  vc0 (6  ,2  I  ,vc0a (6  I  .vc0b (6  )  .ang(6  1  . ten  16  )  ,v  ten  1 6  )  ,yy I  4  ) 
equivalence  (vc0! 1,1!  ,vc0al  ,!vc0( I  ,2 >  ,vc0b) 

************************************************* *********************** 

*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 

*  Read  common  blocks 

************************************************************************ 
cal  1  RWCOMI ( 1  ) 

************************************************************************ 
uz  1 3  1-0 

call  SUMSC (nca  ,za  ,sa  ,ca I 
call  SUMSC (neb  ,zb  ,sb  ,cb  I 
call  VCR  I T0(nco  ,za  ,vc0a l 
call  VCRIT0(ncb  ,zb  ,vc0b I 

esph i h-dcos ( ph  t  h  I 
snph i h-ds i n ( ph i h I 
tnafh-dco8 (phih-phi f l*tnaf 
scafh-SECNT ( tnafh ) 
snafh-tnafh/scafh 
csafh-one/scafh 


-c 


****** ******** ********************************** ********* *************** 

*  Initialize  members  of  /VAROUT/  to  9999  99 
************************************************************************ 

do  50  i-l  ,84 

par out ( i 1-9999  99 
50  con  t i nue 

************************************************************************ 

*  Set  branch  index  to  zero  if  both  branches  are  under  tension 

*  Read  branch  index  and  solution  type  to  /VAROUT/ 
************************************************************************ 

if  ( i so  1  ne  1  and  i so  1  ne  4  1  goto  60 
ibrnch-0 
60  coni i nue 
i i sol -i sol 
i ibrn- ibrnch 


************************************************************************ 

*  Compute  depths  at  anchors 

*  Read  depths  at  origin  and  anchors  to  /VAROUT/ 

************************************************************************ 
da-do-ha  I f  *de 1 y  k 
db-do+del vk 
ddo-do 
dda-da 
ddb-db 

************************************************************************ 

*  Adjust  slack  lengths  as  necessary 

************************************************************************ 
do  80  i-l  ,2 

if  (  not  (isol  eq  4  or  (isol  eq  3  and  ibrnch  eq  i>1> 

&  go  t  o  80 

iof f-2S*< i -1 l 
i l-ioff+24 

i p- i 1*1 

if  (isol  eq  4 )  goto  72 

z ( i p  )  -ph i h 

72  coni i nue 

h  t  n  f -h*dcos ( z ( i p  I  -ph i f  I  *  t  na  f 
nc- (2- i )*nca+ ( i -  I  l*ncb 


I max-zero 
is-iof f 
v-z  < i of (*2 ) 
do  75  ic-l  ,nc 
is- is  +  3 
iv-is-ic 
1  max- lmax+z ( i s I 

if  ( v  It  vc0 ( i  v  ,i  l+htnf  or  v  ge  vc0 I i v- I  ,i  l+htnf  1 
&  goto  75 

Z ( i I  I  -dm i n I ( z ( i I  I  ,  1 max  I 
75  corn  inue 

80  con  t i nue 

*******************************************************************{{*** 

*  Compute  coil  length,  slack  lengths,  branch  di red  ions, 

*  and  branch  loads  as  necessary 

*  Compute  effective  ocean  floor  slopes  for  each  branch 

******* ********************************************** ******************* 
if  lisol  ne  2  and  isol  ne  3 1  goto  M0 
i f  ( ibrnch  ne  1 )  goto  105 
ut-one 
s  t  -sa 
sc-sb 
goto  110 
I  05  cont i nue 
ut-  -one 
st-sb 
sc-sa 

1  I  0  cont i nue 

zk  t -ut  *hal fd 
y k  t -cz*zk  t 

if  ( i sol  ne  2 )  goto  115 
k  te-st*csafh 
goto  120 
1 1 5  cont i nue 

i - 1  I +25* 1 1 brnch- I  ) 
k  te-z ( i  1 
I  20  cont i nue 

kcesq- ( k  te*csphih  1**2+ (zk  t  +  zk  t  +  k  te*snphih  1**2 
lc-dsqr t ( kcesq+ 1 vk t+ykt+kte*tnafhl**2) 
if  (isol  ne  21  goto  130 
coi 1-sc- lc 
1  30  con  1 1 nue 


phic-u 1 1 (hal fp i -dacos (ldsq+kcesq-kte**2)/(t *od#dsqr  t ( kcesq ) ) ) ) 
if  (ibrnch  ne  II  goto  135 

phia-phih 

if  (  not  ( i so  I  eq  2  or  (isol  eq  3  and  ib  eq  zero)))  goto  132 

la-sa 

1  32  coni  mue 
phib-phic 
lb-lc 
hb-zero 
goto  HO 
1  35  cont  mue 

phib-phih 

if  (  not  (isol  eq  2  or  (isol  eq  3  and  ta  eq  zero)))  goio  1 37 

lb-sb 

I  37  coni  mue 
phia-phic 
la-  lc 
ha-zero 
1  40  cont  mue 

tnafa-dcos  (phia-phi  f  l*tnaf 
mafb-dcos (phib-phi f  )*tnaf 

i f  (  not  (isol  eq  I  or  (isol  eq  2  and  ibrnch  eq  l))l  goto  M5 

ha- 1 a/SECNT < t na f a ) 

I  -15  cont  mue 

i f  (  not  (isol  eq  1  or  (isol  eq  2  and  ibrnch  eq  2)))  goto  150 

hb-tb/SECNT ( tnafb  1 
150  cont  mue 

h tna fa-ha* tna fa 

htnafb-hb* tnafb 

if  (isol  ne  ll  goto  160 

la-so 

lb-sb 

160  cont  mue 

if  (isol  ne  3  and  isol  ne  II  goto  170 
1-zero 

I  70  cont  mue 

************************************************************************ 

*  Read  slack  lengths  ■  loads >  ocean  floor  angles,  equalizer  slippage 

*  and  coil  length  to  /VAROUT/ 

****************************************************** ****************** 
1  la-la 
1  lb-lb 


I 


II 


11-1 

hha-ha* 1  0d-3 
hhb-hb* 1  0d-3 
hh-h*t  0d-3 
a  f -da  t  an l I na  f I *raddeg 
afdir-phi f*raddeg 
a  fa-da i an ( tnafa )*raddeg 
ad  n — phia*raddeg 
afb-daian( tnafb T*raddeg 
bd i r-ph i b*raddeg 
sslp-slp 
coi la-0  0 
coi lb-0  0 

if  (isol  ne  2  and  isol  ne  31  goto  190 
if  ( ibrnch  ne  1 )  goto  185 
co i Ib-co i 1 
goto  190 
1  85  coni  mue 
coi la-coi  1 
I  90  corn  mue 


************************************************************************ 

*  Compute  branch  component  displacements  ond  slopes  as  necessary 
************************************************************************ 
if  (isol  ne  1  and  isol  ne  2)  goto  220 
call  FNOOlnca  ,za .la  .tnafal 
call  FNOD (neb  ,zb  , lb  i tnafb 1 
goto  290 
220  cont inue 

if  (isol  ne  3)  goto  250 
if  l ibrnch  ne  1)  goto  225 
if  (tb  ne  zero)  goto  222 
call  FNODlnca >za  , la  itnafa I 
goto  223 

222  cont  mue 

za (2  I- t nafa+dmax I ( zero  . ( za ( 2 1- vc0a (1  )-h  tna  fa  )/ha ) 

223  cont inue 

call  FNOOlncb  , zb  ,1b  , tnafb  1 
1  h-LENH  ( tb  ,ncb  .zb  1 
nc-ncb 
goto  230 
225  cont  mue 


M 

0 


if  lia  ne  zero)  goto  227 
call  FNOOtncb  ,zb  ,1b  .tnafb 1 
goto  228 

227  coni inue 

zb (2 l-tnafb+dmaxl (zero  ,  (zb (2  l-vc0b( 1  )-ht nafb l/hb I 

228  con! inue 

call  FNOOtnca  ,za  ,1a  ,fnafa ) 

1 h-LENH ( t  a  ,nca  ,za ) 
nc*nca 
230  com  inue 

lof  f -25# (2- ibrnch I 
i v- lof ( +1 6 
yy ( 1  )-  -yk  I 
do  235  ic-1  ,nc 

yy ( ic* I  )-yy ( i c  I  +  z ( i y  I 
l y- i y ♦ 1 

235  com  inue 

ssum-zero 
is-iof  f  +  3*nc 
i y-nc  + I 

do  210  ic- I  ,nc 

yyliyl-yyliyl  *dmax  I  (  zero  ,  1  h-ssum  ) 
ssum-ssum»z ( i s  1 
I y- i y-  1 
is- is-3 

240  continue 

i y« lof  f ♦ 1 6 
do  245  ic-l  ,nc 

Z(iy)-yy(lC+t  l-yy(ic) 
iy-iyf-1 

245  continue 

go  t  o  290 
250  con  1 1 nue 

za (2 )- tnafa+dmaxl (zero  , ( za (2 l-vc0a( 1 l-htnafa )/ha I 
zb (2  I- tnafb+dmax I (zero  ,  Izb 12 l-vc0b( 1 1-btnafb >/hb I 
290  com  inue 

t  Compute  node  coordinates  and  read  into  /VAROUT/ 
************************************************************************ 
snph i a-ds i n ( ph i a ) 
snph i b-ds i n ( ph i b  I 
csph i a-dcos  t  ph i a ! 


c  sph i b-dcos ( ph i b 1 
hde 1 y  k -ha  1  f  *de 1 y  k 

xx  t  o-0  0 

i f  (nca  eq  1 )  goto  310 
xx3a-xla*csphia 
i  f  ( nca  eq  2 I  goto  310 
xxSa- ( x I a+  x2a I icsph i a 
3 1 0  con  1 1 nue 
xxlb-0  0 
i emp-x 1 b*csph ib 
i f  ( neb  eq  1 )  goto  315 
xx 3b- temp 

temp-  temptx2b*csphib 
i f  ( neb  eq  2 )  goto  315 
xx5b- temp 

temp- tempt x3b*csphib 
315  cont inue 
xx 7- temp 

xx8- temp+x1*csphih 
zzla-hal fd 

i f  (nca  eq  1  )  goto  320 
zz3a-hal fd+x 1 aJsnphi a 
if  (nca  eq  21  goto  320 
zz5a-ha  1  fd*-(x1a+x2a  l*snph  i  a 
320  cont inue 

zzlb-  -halfd 
temp-  -hoi fd+x 1 b*snph i b 
if  (neb  eq  1 )  goto  325 
zz3b-temp 

t  emp- 1  emp+x2b*snph i b 
if  (neb  eq  21  goto  325 
zz5b-temp 

t  emp- 1  emp ♦ x  3b*  snph i b 
325  continue 
zz7- temp 

zz8- tempt x^*snphih 
yylo-hdelyk 

if  (nca  eq  II  goto  330 
yy3o-hdelykty la 
i f  (nca  eq  2 1  goto  330 


yy5a-hdelyli  +  ( y 1 a+v2a ) 

330  coni inue 

yylb-  -hdelyk 
lamp-  -hdelyli+ylb 
if  (neb  eq  1 )  goto  335 
yy  3b- 1  amp 
temp-  temp-*-y2b 
if  (neb  eq  2)  goto  335 
yy5b-temp 
temp- temp+y3b 
335  cont inue 
yy7- temp 
yy8-temp+y4 

************************************************************************ 

*  Compute  node  angles  and  tensions  and  read  into  /VAROUT/ 
************************************************************************ 
if  (iso l  eq  3  and  i bench  eq  21  goto  410 
cal  l  CTEN3 Inca  ,za  ,tnafa  .ta  .ang  ,ten  ,vten) 
goto  415 
410  cont inue 

cal  1  CTEN2(nca  ,za  ,vc0a  ,M  .inafa  .ang  ,ten  ,vten  i 
415  cont inue 

aal a-ang ( 1 1 
1 1 1a-ten( I ) 
vv 1 a-v  t  en ( 1  ) 
oa2a-ang(2 ) 

1 1 2a- ten (2) 

vv2a-vten(2  1 

if  (nca  eq  1  l  goto  420 

aa3a-ang(3l 

1 1 3a- ten (3 ) 

w3a-v  ten  ( 3 ) 

aa4a-ang(4 ) 

r  1 4a- ten (4  ) 

vv4a-v  ten (4  1 

if  (nca  eq  21  goto  420 

aa5a-ang(5 ) 

1 1 5a- ten (5  1 
vvSa-v t  en (5  1 
aa6a-ang (6 ) 
t  t6a-ten(6) 
vv6a-vten(6) 


ZOH 


420  coni  inue 

if  (iso!  eq  3  and  ibrnch  eq  11  goto  430 
cal  1  CTEN3 (neb  ,zb  ,mafb  ,1b  ,ang  ,ien  ,vienl 
goto  435 
430  continue 

cal  1  CTEN2 (neb  ,zb  ,vc0b  ,tb  ,inafb  ,ang  ,ien  ,vien  ) 
4  35  con I i nue 

aalb-ang( 1 ) 
t i 1b- ten ( 1 1 
vv I b-v  ten ( 1  1 
aa2b-ang(2 I 
t i2b-ten(2 I 

vv2b-v  ten ( 2 1 

if  (neb  eq  1  I  goto  440 
aa3b-ang ( 3  I 
i i3b-ten(3) 
vv3b-v i en ( 3 ) 
aa4b-ang ( 4 1 
i 1 4b- ten (4  I 
vv4b- v I en ( 4 ) 
if  (neb  eq  21  goto  440 
aa5b-ang(5 1 
t i 5b- ten (5 1 
w5b- v  t en (5  I 
aa6b-ong ( 6 1 
1 1 6b- ten (6  I 
vv6b-vten(6  1 
440  coni i nue 

ang7-da  t  an ( t ana7 I 
ang8-da  t  an ( t  ana8 1 
if  (1  eq  zero)  goto  450 
ten7- (h*scafh-w4* 1 tsnafh )» 1  0d-3 
goto  455 
450  cont inue 

ten7-h*SECNT ( tano7 1*1  0d-3 
455  cont inue 

ten8-h*SECNT( tana8)*1  0d-3 
aa7-ang7*raddeg 
aa8-ang8*raddeg 
i t7-ten7 
t  t8-ten8 


1 


SQZ 


vv7-ten7*dsin(ang7 ) 
vv8-ten8*ds in(ong8 I 

************************************************************************ 

t  Compute  elevation  vie*  parameters 

************************************************************************ 

cal  1  ELV2(phih  , i na f a  ,tnafb  ,tnafh  iscafh  ,snafh  ,csafh ) 

************************************************************************ 

*  Read  solutions  for  unknown  input  parameters  to  /VARIN/ 
************************************************************************ 

call  CROBAK ( tnafa  i tnafb ) 

************************************************************************ 

*  Write  to  common  blocks  /VAROUT/  and  /VARG/ 
************************************************************************ 

call  RWCOMI (21 


return 


ei  sys  f inal / 1 2 (or/crdbak  fortt 

subroutine  CRDBAK ( tnafa  ,  tnafb ) 

t ttttt*t**t*t***tttttt***tttt*tt*t***tt*ttt*ttt*tttt*t*ttt**ttt**ttt**tt 

implicit  double  precision  (a-z) 

double  precision  tnafa. tnafb 

integer *2  iileg.iisf 
integer*^  nnca  ,nncb 
real  angla.anglb, 

A  scop  l  a  iscoplb  ,wgt  la  >«gt  lb  .clmpla  >c  Imp  lb  , 

A  scop2o ,scop2b  ,*gt 2a  ,wgt2b  lclmp2a  .clmp2b . 

A  scop3o  ,scop3b  ,wgt3a  ,*gt3b  ,sl  ip  ,fnct  ,clmp3  .scopA  ,*gtA  .anksep  . 

&  plx  ,plz  ,pld  ,p2x  ,p2z  ,p2d  .p3x  ,p3z  >p3d  > 

A  hload  ,hdir  .rbuoy  .xbuoy  ,Zbuoy  .deptho  >pdir 
common  /VARIN/  i i 1  eg  . i i s t  ,nnca  ,nncb  ,ang! a  ,angl b  , 

A  scop  I  a  .scop  lb  .wgtTa  >«gt lb  .clmpla  .clmplb  , 

A  scop2a  .scop2b  ,wg  1 2a  .«g  1 2b  ,c 1 mp2a  ,c 1 mp2b , 

A  scop3a  ,scop3b  >«gt3a  ,*gt3b  ,sl  ip  .frict  ,clmp3  .scopA  .»gtA  .anksep  , 

A  pi  x  .pi  z  .pi  d  ,p2x  ,p2z  ,p2d  .p3x  ,p3z  ,p3d  . 

A  hload  ,hdi r  .rbuoy  .xbuoy  .zbuoy  .dept ho  .pdir 
real  parinlAB) 

equivalence  ( ang 1  a  .par i n ( 1  I  I 

i  n  t  eger  *2  i  I  eg  ,  i  s  i  ,nca  ,ncb  ,nwa  .nwb  .isol  .ibrnch  ,uz  (5  I 
double  precision  z (67  )  ,cz  .cx  ,d  , t a  . t b 

common  /VGLOB/  i  leg  ,ist  .nca  .neb  .z  .cz  ,c*  ,d  >ta  >tb  .n*a  ,nwb  . 

A  isol  , ibrnch  ,uz 
double  precision  za(25  )  ,zb(25 J 
equivalence  lz( 1  l  ,zal 1  11  ,lz(26 )  ,zb< 1 ) ) 

double  precision  ha  .ala  >va  .sla  ,wla  >cla  >s2a  >w2a  >c2a  >s3a  >«3o  > 

A  xa  >ya  .x  I  a  .x2a  .x3o  .y  1  a  .y2a  >y  3a  . 

A  t  an a2a  .  t ona3a  ,  t  anaAa  ,  t ana5a  ,  t  ana6a  ,1a  ,ph i a 
Squivalence  (zall  )  ,ha)  ,lzo(2)  .ala.va)  , 

A  (zo(3l  ,sla)  .IzalAl  ,#1a)  .IzalS)  .da)  , 

A  (za(6l  ,s2al  ,  (za(7)  ,w 2a)  .  I  za < 8  I  >c2a  )  . 

A  (za 19 ) >s3a  I  ,  (za< 10 1  .»3a  )  ,  (za ( M  )  xa )  ,  I  za  1 1 2  I  >va  )  . 

A  I  za  ( 1 3  I  ,x  I  a  I  .  I  zo  l  M  )  ,x2a)  ,lzaM5  )  ,x3a  )  , 

A  (zal 16  )  .y lo  I  .  (zal 1 7  )  ,y2a )  , I za 1 1 8  I  ,y3a  J  , 

A  (za(19l  ,tana2a)  ,(za(20)  ,tana3al  ,lzol2l  )  .tanala)  , 

A  ( za 1 22 l  ,  i ana5a )  .  ( za ( 23  )  ,  t  ana6a  )  ,(za(2l)  ,1a)  ,lza(25)  ,ph i a ) 
double  precision  hb  .alb  ,vb  ,slb  .»lb  ,clb  ,s2b  ,w2b  ,c2b  ,s3b  ,w3b  . 

A  xb  ,yb  .xlb  .x2b  ,x3b  .ylb  ,y2b  ,y3b  , 


4  t  ana2b  ,  t  ana3b >  >  analb  ,  t  ana5b  ,  t  ana6b  ,  1 b  ,ph i b 
equivalence  (zb (I )  ,hb  )  ,  ( zb (2 1  ,al b ,vb  I  , 

4  (zb  ( 3  )  .sib)  ,(zbm  ,wlb)  >  ( zb  ( S  1  ,clb>  , 

4  ( zb  ( 6  )  >s2b  I  ,  (zb(7l  ,w2b  )  .(zb(8)  ,c2b  )  , 

&  (zb  (9  I  ,s3b  l  ,  ( zb  1 1 0  )  ,»3bl  ,  ( zb  M  I  I  ,xb  )  .  I  zb  1 1 2  I  ,yb  )  , 

4  (zb ( I  3  I  ,x  lb  I  ,lzb(M  I  ,x2b  I  ,  (zbdSl  ,x3b  )  , 

4  (zb ( 16  I  .y  lb  )  ,  ( zb  (17)  ,y2b  )  ,  (zb  1181  ,y3b)  , 

&  ( zb ( 1 9  I  .  i ana2b I > ( zb ( 20  I  ,  t ana3b  I  ,  ( zb ( 2 1  )  ,  i analb  )  , 

&  (zb (22  I  .  t anaSb  I  .  (zb (23  )  . t ana6b  I  , ( zb (21 )  . lb  I  , ( zb (25  1  ,phib I 

double  precision  coi  1  .sip  .fret  .c3  >s1  .*1  >x1  ,y1  ,iana7  ,tana8  .1  , 

&  h, phih.no i  .xiot  .z(oi  ,do 

equivalence  ( z (51  )  ,coi I  I  ,  ( z (52  I  ,slp>  ,  ( z ( 53 )  ,  f  rc t ) , ( z ( 51 1  >c3 I . 

4  ( z  (55  I  ,s1  I  ,  ( z  (56  )  ,*1 1  ,(z(57l  ,x1)  ,lz(58)  ,y1)  , 

&  (z(59)  ,tana7)  ,(z(60>  ,  ranaS)  ,  ( z ( 6 1  >  .1  I  > 

&  ( z  (62  I  .h  I  ,  ( z  (63  1  .phihl  , 

4  ( z  (61  I  ,r  ioi  I  ,  ( z  (65  I  ,x  lot  I  ■  ( z  (66  I  ,z  t  o  i  )  ,  I  z  1 67  I  ,do  I 

double  precision  pi  .halfpi  .degrad  .raddeg  .zero  .one  , ha  1 f 
integer *2  izero  ,ione  ,i two 

common  /VCONST/  pi  ,hal fpi  .degrad  .raddeg  ,ZPro  ,one  ,hal f  , 

4  izero  ,ione  ,  i two 

i n t eger *2  i  .10  ,iz  ,i  tab  ,i con  .commap  .con t  y p  ,numox  ,u  1 5  ) 

*t*«:Mttt*i*4^t**:MM*****t****t******t****t****  ************************ 
numax-5 
■  0-1 

do  20  l-l  .numax 
u ( i  l-uz ( i  I 

if  (util  ne  0 1  10-10+1 
20  cont  mue 

if  ( i s t  ne  21  goto  50 
u( i0  1-2 
u( i0+l  1-27 
50  cont  mue 

do  200  i - 1  .numax 
i  z-u(  i  1 

if  ( i z  eq  0  1  goto  200 
i ieb-COMMAP( iz  ) 
i con-CONT YP ( i z  I 

goto  ( I  1 0  . 1 20  1 1  30  1 1 10 , 1 50  I  .  i con 
I  10  cont  mue 

par  m(  i  tab  l-z  1 1  z  l 
goto  200 


1 20  cont inue 

par  in ( i lob  )-z ( 12 1*1  0d-3 
goto  200 
1 30  coni inue 

P-inUiab I  - 1  do  t  or.  <  z  I iz  I  I  -dot  an  ( tnafa )  Uraddeg 
t 10  coni inue 

par m ( i tab  )- (do ton (z ( 1 z ) I -da tan  I ma/b ) Xraddea 
go 1 o  200  a 

1 50  cont inue 

par  m ( 1  tab  )-z ( iz )*raddeg 
200  cont inue 
xbuov-x lot 
zbuoy-z  to  1 
deptho-do 


ei  sys  f mol/ 1 2  for /commop  forH 
f  one  1 1  on  COMMAP ( i  z  I 

************************************************************************ 
i n  t  eger  *2  commop  ,  i z 

************************************************************************ 
i  f  ( i  z  1 1  2  or  i  z  g  t  1 0  )  go  i  o  20 
commop- 2* i z - 3 
goto  100 
20  con i i nue 

if  (iz  It  27  or  12  gt  35 1  goto  30 
commap-2* i z-52 
goto  100 
30  coni i nue 

if  ( i z  It  52  or  i z  g  t  56  I  go  t  o  40 
commop- i z-33 
goto  100 
40  corn inue 

if  (iz  It  62  or  iz  gt  67 )  goto  100 
commop- i Z -28 
100  cont i nue 


return 


et  svs  f inol/t2for/cont  yp  fort! 
function  CONTYPfizI 

******************************************* ***************************** 

integer *2  com yp,iz 

**********1**************************************** ********************* 
I IZ- IZ 

1 1 - ( i  »z-5  l*lt i z-8  )* ( i iz-30  1 

12- lnz-33)*<  i  i z-S4  )*(  i  iz-62) 

if  (il  ne  0  and  1 2  ne  0 1  goto  30 
coniyp-2 
goto  100 
30  con  1 1 nue 

if  ( iz  ne  2 1  goto  40 
contyp-3 
goto  100 
40  coni inue 

if  ( iz  ne  27  1  goto  50 
contyp-4 
goto  100 
50  con  t i nue 

if  ( iz  ne  63  I  goto  60 
contyp-5 
goto  100 
60  com  mue 
contyp-l 
1 00  com  mue 


re  turn 


ei  sys  f inal/t2for/fnod  for## 

subrout  me  FNODlnc  ,z  ,1  .tanaf  ) 

************************************************************************ 

*  Compute  node  d i sp 1 acemen t s  and  angles  for  single  branch 

*  with  junction  on  ocean  floor 

************************************************************************ 
implicit  double  precision  (a-z) 

mteger*2  nc 

double  precision  z(2Sl  >1  .tanaf 

double  precision  pi  ,hal fpi  .degrad  ,raddeg  .zero  .one  ,hal f 
i n  t  eger *2  i zero  ,  i one  ,  i t  wo 

common  /VCONST/  pi  ,hal fpi  .degrad  .raddeg  .zero  .one  ,hal f  , 

&  i zero  ,  i one  ,  i t  wo 

integer *2  ic.io.is.ix.iy 

****** ***** ************************************************************* 

cosaf-one/SECNT  t  tanaf 1 

ssum-zero 

do  100  i C“ I  .nc 

ia-l6*2*ic 

if  ( ic  eq  It  i a-2 

z I i a  I - 1  ana  f 

i s-3* ic 

s-dmax I  ( zero  .dmml  ( z ( i s  I  ,1  -ssum  I  I 
ix-12+ic 
z( ix )-s*cosaf 
i y- 1 5+  ic 

Z ( ly )-z ( i x )*  tanaf 
ia-1 7t2*ic 
z 1 1 a ) - 1 ana  f 
ssum-ssum+z ( is  I 
1 00  con  1 1 nue 
return 
end 

* 


1 


1\7 


ei  sys  f mal/i2for/lenh  for## 
f unci  ion  LENHIce  ,nc  ,z I 

************************************************************************ 

implicit  double  precision  (a-z I 

mt eger*2  nc 

double  precision  lenh  ,ce  ,z (25  ) 
integer *2  is 

*******«**$**************************** *************** ****** ************ 
is-3*nc 

wgt-z( is l*z< is+l  1 

if  (nc  gt  I  and  ce  gt  wgt  1  goto  10 
lenh-ce/z ( is*  I  ) 
goto  100 
10  corn  mue 
lenh-z ( is  1 
wgt-wgt*z( is-1  ) 
if  (ce  le  wgt  1  goto  100 

if  (nc  gt  2  and  ce  gt  wgt +z (6  l*z (7  1  1  goto  30 
lenh- lenh* (ce-wgt  1  / z ( i s-2  I 
goto  100 
30  com  mue 

lenh- lenh +  z (6  I 
wgt -wgt  +  z (6  )*z ( 7  I *z (5  ) 
if  (ce  le  wgt)  goto  100 
lenh- lenh* (ce-wgt  )/z ( #  1 
1 00  cont  mue 


et  sys  f inal/t2for/elv2  for#t 

subrout  me  ELV2(phip  ,tnafa  .tnafb  ,tnafh  ,scafh  .snafh  ,csafh  I 

************************************************************************ 

implicit  integer *2  («) 
implicit  double  precision  la-z  I 

double  precision  ph 1 p  , t na f a  1 1 na fb  . t na fh  ,sca fh  ,sna fh  ,csa fh 

double  prec ision  I  I  a  ,1  lb  ,  1 1  ■  tana  ,  tanb  ,  t anr  , 

A  xxla  ,xx3a  ,xxSa  .xx3b  .xxSb  ,xx7  ,xx8  , 

A  gall  ,ga!2,ga2l  ,ga22  ,ga3l  ,ga32  , 

A  gbl I  ,gbl2  .gb2l  ,gb22  ,gb3l  igb32  , 

A  gl  ,g2  ix  fa  ,x  fb  ,x  f 

common  /VARC/  1  la  >1  lb ,1  I  ,tana  ,tanb  ,ianr  , 

A  xxla  ixx3a  ,xx5a  ,xx3b  ixx5b  ,xx7  ,xx8  , 

A  gal  1  ,gal2  .ga2l  ,ga22  ,ga31  ,ga32  , 

A  gbl  I  ,gbl2,gb2l  ,qb22  ,gb3l  ,gb32  , 

A  gl  >g2  ,xfa  ,x  f b  ,xf 

mteger*2  i  leg  list  ,nca  ,ncb  ,n*a  ,n#b  ,iSol  ,  i  bench  ,uz  1 5  I 
double  precision  z  (67  I  ,cz  ,cx  ,d  ,  i  a  .  tb 

common  /VCLOB/  i  I  eg  ,  i  s  t  ,nra  ,ncb  ,z  ,cz  ,cx  ,d  ,ia  .'b  ,nwa  ,nwb  , 

A  i  so  1  ,  i  br  nch  ,u 2 
double  precision  za (2S  I  .zb (25  I 
equ i valence  ( z ( I  I  ,za ( I  I  I  ,  ( z ( 26  I  ,zb ( I  !  I 

double  precision  ha  ial  a  ,va  ,s  I  a  ,*  I  a  ,c  1  a  ,s2a  ,«2a  ,c2a  >s3a  ,w3a  , 

A  xa  iva  ,xla  ,x2a  >x3a  iyla  ,y2a  iy3a  , 

A  t  ana2a  ,  t  anaSa  .  t ana4a  1 1 ana5a  >  t  ana6a  ,  1  a  .ph i a 
equ i  volence  (  za  (  I  >  ,ha  I  .  I  za  ( 2  I  ial  a  ,va  )  , 

A  ( za ( 3  I  .s I  a  l  ,lzal1l  ,» I  a  I  .  ( za (5  I  ,c  I  a  I  > 

A  (zo(6)  ,s2a  i  i(za(7)  ,w2a  I  .(za(8i  ,c2a  I  > 

A  ( za  ( 9  l  ,s3al  .  t  za  (101  ,w3a  >  ,  I  za  f  1  I  I  .xa)  ,(zal'2i  ,ya)  . 

A  f  za  (13  1  ,x  1  a  l  ,(za(Hl  ,x2a )  ,  ( za  (  I  5  I  ,x3a  l  . 

A  (za(  16  )  ,yla  1  ,(za(  I  7  I  ,y2a  l  ,(za  ( 18  I  ,y3a  )  , 

A  (  za  (  1  9  I  ,  t  ana2a  I  .  ( za  (20  I  .tana3al  .lza(21  1  .( ana*1a  )  , 

A  ( za ( 22  I  1 1  ana5a I  ,  ( za 123  I  .tana6al  .  ( za ) 24  I  .  1  a  »  ,  I za ( 25  l  .ph i a  I 

double  precision  hb  ,a  I  b  ,vb  ,s  I  b  ,«*  I  b  ,c  I  b  ,s2b  .*2b  ,c2b  .s3b  ,«*3b  . 

A  xb  .yb  .xlb  .x2b  ix3b  .ylb  ,y2b  .y3b  , 

A  t  ana2b  .  t  ana3b  .  t  ana4b  .  t  anaSb  ,  t ana6b  ,  I b  ,ph i b 
equivalence  ( zb  ( 1  I  ,hb  I  , l  zb  (21  .a'b.vbl  , 

A  I  zb  ( 3  I  ,s  I  b  l  .Izblll  ,w  I  b  )  ,  ( zb  ( 5  I  ,c  l  b  1  , 

A  ( zb  (6  I  ,s2b  I  .  ( zb  (  7  )  ,w2b  1  ,(zb(8l  ,c2b  I  , 

A  ( zb (9  I  ,s3b  I  , ( zb ( 1 0 1  ,w3b  )  ,  ( zb 1 1  I  )  ,xb  )  ,  ( zb ( 1 2  > ,yb )  , 


A  (zb(13>  ,x1b)  ,tzb(M)  ,x2b  )  ,  ( zb 1 1 S  »  ,x3b  J  , 

A  t  zb  (1 6  )  ,y  1  b  I  ,  t  zb  M  7  )  ,y2b  I  ,  ( zb  (  1 8  I  ,y  3b  )  , 

A  l zb (19)  ,  tana2b)  ,  (zb (20)  ,tana3b)  ,(zb(2l  )  ,  tana4b)  , 

A  (zb (22  )  ,  tana5b  )  ,  ( zb (23  )  ,  t ana6b  I  ,  ( zb (24  )  ,1b)  ,  ( zb (25  )  ,phib ) 
double  precision  coil  ,s  lp  ,  frc  t  ,c3  .s4  .*4  ,x4  ,y4  ,  i  ana7  ,  iana8  ,1  , 

A  h  ,phih  ,rlot  ,xiol  ,zlot  ,do 

equivalence  ( z (5 1  )  ,co il  I  ,  (z (52  )  ,slpl  » ( z ( 53 )  ,frci  )  ,  ( z (54 )  ,c3)  , 

A  ( z ( 55  )  ,s4  I  ,  (z(56  )  ,w4  I  ,  (z(S7  )  ,x4  I  ,  (z  158  )  ,y4  )  , 

A  ( z ( 59  )  ,  i ana7  I  ,  ( z ( 60  )  ,  l ana8  )  ,  ( z ( 6 1  I  ,1  )  , 

A  (z(62)  ,h  )  ,(z(63)  ,phih)  , 

A  ( z  ( 64  )  ,rtoi  I  ,(z(65l  ,xtoi  )  ■  ( z  ( 66  )  ,ziot  I  ,(zi67)  ,do) 

double  precision  pi  .halfpi  , degrad  ,raddeg  .zero  .one ,ha 1 f 
mteger*2  i zero  ,  tone  , i r wo 

common  /VCONST/  pi  ,hal fpi  , degrad  .raddeg  .zero  .one  ,hal f  , 

A  izero  .tone  ,  i two 

double  precision  delyk  . t wod  ,ha 1 f d  ,dsq 
common  /VAN CH/  de I y k  ,  t wod  ,ha 1 f d  ,dsq 

******  **************************************************;*******;********* 

cosdp-dcos iph i a-ph i p  l 

if  (  no i  I ( i so  1  eq  3  and  ibrnch  eq  I  l  or  i so  I  eq  4  I )  go  t  o  5 1 0 
call  GCOEFF (nca  ,za  ,  t no f  a  ,gal  I  ,ga )  2  ,ga2 1  ,ga?2  ,ga3 1  ,ga32  ,2  ) 
x fa-one/cosdp 
5  I  0  con l i nue 

i ana- t  no  f  a/cosdp 

1 1  a- I a*dsqr i ( cosdptcosdp*  t nafa*  t  na  f  a  )  /SECN1 i mafal 
x  x 1  a- ha  1 f  d*ds i n ( ph i p  ) 
i emp-xx I a+x 1 a*cosdp 
y y 7-hal f  *del y  k  *y I  a 
i f  (nca  eq  I  I  goto  520 
xx 3a- temp 

temp- temp>x2a*cosdp 
yy 7-yy7+y2a 
if  (nca  eq  2)  goto  520 
xxSo- temp 

i emp- temp*x3a*cosdp 
y y  7-y y  7  +  y  3a 
520  com  i  nue 

x  x  7- t  emp 


cosdp-dcos (ph i b-ph i p ) 

if  (  not  ( ( t  so  1  eq  3  and  ibrnch  eq  2  )  or  i sol  eq  4 ) )  goto  530 


ZlS 


call  GCOEFF  (neb  ,zb  ,inaft>  ,gb1 1  ,gbl2,gb2l  ,gb22  ,gb3l  ,gb32  ,2  I 
x fb-one/cosdp 
530  coni  mue 

i anb- i na  f b/cosdp 

I  lb- I b*dsqr i (cosdp*cosdp+ mafb* i nafb  l/SECNT I tnafb I 
i f  (neb  eq  1  I  goto  510 
xx 3b-  -xx la+x (btcosdp 
if  (neb  eq  2)  goto  510 
xx5b-xx3b*x2b*cosdp 
510  com  mue 

w7-2ero 

cosdp-dcos ( ph i h -ph i p ) 
if  (I  gi  zero  I  goio  550 
tna-iana7 
x-zero 
v-vy  7 
goto  555 
550  com  mue 
ina-inafh 
x- 1 *csa  fh 
y*yy7* 1 *snafh 
555  com  mue 
x-zero 

sca-SECNT (inal 
gi - l ina  +  sca  )*dexp ( -wl*x/h ) 
g2-y- <h*sca/w1  I 
x  f-one/cosdp 
i anr- tnafh/cosdp 

11-1 *dsqr i (cosdp*cosdp+  mafh*  t  nafh  1  /sea  fh 
xx8-xx7+x1*cosdp 


re i urn 


ei  sys  f inal / t2 for/c ten2  forll 

subrour  me  CTEN 2 Inc  ,z  (vc0  ,ih  ,tanb  ,ang  ,ten  ,vtenl 

************************************************************************ 

implicit  double  precision  (a-zl 

integer*2  nc 

double  precision  z (25  1  ,vc0(6 )  ,  th  ,  t anb  ,ang 16 )  ,  ten  16 )  ,v t en!6 ) 

double  precision  pi  ,halfpi  >degrad  ,raddeg  ,zero  ,one  ,hal  f 
integer *2  i zero  , i one ,  i two 

common  /VCONST/  pi  ,hal fpi  idegrad  >raddeg  ,zero  ,one  ,hal f  , 

&  izero  1 1 one  ii two 

integer *2  ic  . m  , j 

************************************************************************ 

s i nb- t  anb/SECNT ( t  anb  1 
bdeg-da  t  an ( t  anb I *r addeg 

do  100  ic-1  ,nc 
do  100  j-1  ,2 
i n-2* ( i c -  1  )  ♦ j 

t - ( vc0 1 in  1  - th I* 1  0d-3 
if  ft  It  zero  1  goto  20 
ten ( in  1-  - t  *s inb 
v  t  en ( i n  I  - s i nb*  t  en ( i n  I 
ang< in  l-bdeg 
goto  50 
20  con  1 1 nue 
tent  in  1-  -t 
v  t en ( in  1  -  - t 
ang (in) -90  0 
50  coni inue 
100  com  inue 

return 

end 


HZ 


ei  sys  f inal/t2for/cten3  for## 

subroul  me  CTEN3 (nc  ,z  ,  tanb  >  t  x  ,ang  ,  ten  ,v  ten  ) 
************************************************************************ 
implicit  double  precision  (a-zl 

integer *2  nc 

double  precision  z (25  I  , t anb  , t x  ,ang (6 )  , t en 1 6  )  ,v ten (6  I 

double  precision  pi  ihalfpi  .degrad  ,raddeg  , zero  , one  , ha  1 f 
integer*2  i zero  , tone >i two 

common  /VCONST/  pi  ,hal fpi  idegrad  ,raddeg  ,zero  ,one  ,hal f  , 

&  izero  ,ione  , i two 

integer *2  ic  ,in  ,j 

************************************************************************ 

tenl (w  l-hsecb-w*s mb 

h-z(  I  I 
s I -z (3  I 
*l-z(1) 
c i -z (5  l 
s2-z 16 ) 
w2-z ( 7  1 
c2-z 18  l 
s3-z 19  l 
w3-z (101 
l-z(2l ) 

secb-SECNT ( tanb ) 
s  mb- tanb/secb 
b-datan( tanb ) 
hsecb-h*secb 

angl I l-datan(z (2)1 
ang 1 2  )  -da  t  an ( z ( 1 9 ) ) 
if  ( nc  eq  1  1  goto  1 000 
ang ( 3 ) -da  t  an ( z ( 20  I  I 
ang ( 4 ) -da  t  an ( z ( 2 1  I  I 
if  Inc  eq  2)  goto  1000 
ang 1 5 ) -da  t  an ( z  1 22  )  ) 
ang ( 6  I -da  t  an ( z ( 23  I  I 
1000  continue 


if  (1  eq  0  0d0)  goto  1810 
if  (1  ge  si  I  goto  1300 
tent  1  I- tenl (wt*l 1 
go i o  1 820 

1  300  coni  mue 

if  (1  g t  s 1  I  goto  1 400 

if  (nc  eq  11  goto  1320 

t  f 3-h*SECNT (2(20  I l*dcos (ang< 3  1-b  1 

tend  )-t  f3-(wl*s1+c1  1*sinb 

ten  (2  1-  t  f 3-c  I  *s  mb 

goto  1 350 

1  320  cont inue 

tend  )-tx-»1*s1*sinb 
ten(21-tx 

1 350  cont inue 
goto  1830 

1400  continue 

if  (1  ge  si  *s2 )  goto  1500 

»gt2-w2* ( 1 -sl  I 

tend  1- tenl  (w  1  *st  +c1  *wgt  2  I 

t  en ( 2 ) *  t  en 1  ( c 1 +  »g  *  2  • 

t  en 1 3  1- tenl ( wg  1 2 1 

goto  1840 


1500  cont inue 

if  (l  gt  sds2i  goto  1600 
if  (nc  eq  21  goto  1520 
wgt2-*2*s2+c2 

tfS-h*SECNT<z(22) l*dcos f ong (5 ) -b 1 
tend  1-t  f5't*1*s1+c1+»gt2)*sinb 

ten (2  l-t fS-lcl ♦*gt2J*sinb 
ten (3 1-t fS-*at2*sinb 
ten(4  1-t  fS-c2*smb 
go  f  o  1 550 
1520  continue 

•gt2-w2*s2 

tend  l-tx-  iwl *sl *cl ♦»gt2  i*smb 

ten(2)-tx-(cdwgt2)*sinb 
ten(3 1- 1  x-#gt2*S  mb 
i en ( 4  1  - t  x 
1 550  con  1 1 nue 


3 


>en( in  )-ien( m  )*1  0d-3 
vienl in  l-ien( in)*dsin(ang( m ! ) 
ang( m  )-ang( in Itraddsa 
20 1 0  con  t i nue 
return 
end 

* 
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